Re: File Input Question

I'm not sure what you mean "to tab".

To have a user select a folder, not a file, I use the below (which is fantastic and clearly not my own work). This lets you specify a default folder, have the user create a new folder - whatever you need.

Watch for wrapping - it's going to be bad. I couldn't find a decent page of this to link to so I've pasted it below.

One module with this code:

Option Explicit

Dim CntrDialog As Boolean

Private Type BROWSEINFO
hOwner As Long 'Handle to the owner window for the dialog box.

pidlRoot As Long 'Address of an ITEMIDLIST structure specifying the location
'of the root folder from which to browse. Only the specified
'folder and its subfolders appear in the dialog box.
'This member can be NULL; in that case, the namespace
'root (the desktop folder) is used.

pszDisplayName As String 'Address of a buffer to receive the display name of the folder
'selected by the user. The size of this buffer is assumed to
'be MAX_PATH bytes.

lpszTitle As String 'Address of a null-terminated string that is displayed above
'the tree view control in the dialog box. This string can be
'used to specify instructions to the user.

ulFlags As Long 'Flags specifying the options for the dialog box.
'See constants below

lpfn As Long 'Address of an application-defined function that the dialog box calls
'when an event occurs. For more information, see the
'BrowseCallbackProc function. This member can be NULL.

lParam As Long 'Application-defined value that the dialog box passes to the
'callback function (in pData), if one is specified

iImage As Long 'Variable to receive the image associated with the selected folder.
'The image is specified as an index to the system image list.
End Type

Private Const WM_USER = &H400
Private Const MAX_PATH = 260

'ulFlag constants
Private Const BIF_RETURNONLYFSDIRS = &H1 'Only return file system directories.
'If the user selects folders that are not
'part of the file system, the OK button is grayed.

Private Const BIF_DONTGOBELOWDOMAIN = &H2 'Do not include network folders below the
'domain level in the tree view control

Private Const BIF_STATUSTEXT = &H4 'Include a status area in the dialog box.
'The callback function can set the status text
'by sending messages to the dialog box.

Private Const BIF_RETURNFSANCESTORS = &H8 'Only return file system ancestors. If the user selects
'anything other than a file system ancestor, the OK button is grayed

Private Const BIF_EDITBOX = &H10 'Version 4.71. The browse dialog includes an edit control
'in which the user can type the name of an item.

Private Const BIF_VALIDATE = &H20 'Version 4.71. If the user types an invalid name into the
'edit box, the browse dialog will call the application's
'BrowseCallbackProc with the BFFM_VALIDATEFAILED
' message. This flag is ignored if BIF_EDITBOX is not specified

Private Const BIF_NEWDIALOGSTYLE = &H40 'Version 5.0. New dialog style with context menu and resizability

Private Const BIF_BROWSEINCLUDEURLS = &H80 'Version 5.0. Allow URLs to be displayed or entered. Requires BIF_USENEWUI.

Private Const BIF_BROWSEFORCOMPUTER = &H1000 'Only return computers. If the user selects anything
'other than a computer, the OK button is grayed

Private Const BIF_BROWSEFORPRINTER = &H2000 'Only return printers. If the user selects anything
'other than a printer, the OK button is grayed.

Private Const BIF_BROWSEINCLUDEFILES = &H4000 'The browse dialog will display files as well as folders

Private Const BIF_SHAREABLE = &H8000 'Version 5.0. Allow display of remote shareable resources. Requires BIF_USENEWUI.

'Message from browser to callback function constants

Private Const BFFM_INITIALIZED = 1 'Indicates the browse dialog box has finished initializing.
'The lParam parameter is NULL.

Private Const BFFM_SELCHANGED = 2 'Indicates the selection has changed. The lParam parameter
'contains the address of the item identifier list for the newly selected folder.

Private Const BFFM_VALIDATEFAILED = 3 'Version 4.71. Indicates the user typed an invalid name into the edit
'box of the browse dialog. The lParam parameter is the address of
'a character buffer that contains the invalid name.
'An application can use this message to inform the user that the
'name entered was not valid. Return zero to allow the dialog to be
'dismissed or nonzero to keep the dialog displayed.

' messages to browser from callback function
Private Const BFFM_SETSTATUSTEXTA = WM_USER + 100
Private Const BFFM_ENABLEOK = WM_USER + 101
Private Const BFFM_SETSELECTIONA = WM_USER + 102
Private Const BFFM_SETSELECTIONW = WM_USER + 103
Private Const BFFM_SETSTATUSTEXTW = WM_USER + 104

Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

'Main Browse for directory function
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'Gets path from pidl
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'Used by callback function to communicate with the browser
Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, _
hpvSource As Any, ByVal cbCopy As Long)

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Private Declare Function LocalAlloc Lib "kernel32" _
   (ByVal uFlags As Long, _
    ByVal uBytes As Long) As Long

Private Declare Function LocalFree Lib "kernel32" _
   (ByVal hMem As Long) As Long


''The following declarations for the option to center the dialog in the user's screen
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, _
 ByVal x As Long, _
   ByVal y As Long, _
    ByVal nWidth As Long, _
     ByVal nHeight As Long, ByVal bRepaint As Long) As Long
''End of dialog centering declarations

Function GetDirectory(InitDir As String, Flags As Long, CntrDlg As Boolean, Msg) As String
Dim bInfo As BROWSEINFO
Dim pidl As Long, lpInitDir As Long

CntrDialog = CntrDlg ''Copy dialog centering setting to module level variable so callback function can see it
With bInfo
.pidlRoot = 0 'Root folder = Desktop
.lpszTitle = Msg
.ulFlags = Flags

        lpInitDir = LocalAlloc(LPTR, Len(InitDir) + 1)
        CopyMemory ByVal lpInitDir, ByVal InitDir, Len(InitDir) + 1
        .lParam = lpInitDir

If Val(Application.Version) > 8 Then 'Establish the callback function
.lpfn = BrowseCallBackFuncAddress
Else
.lpfn = AddrOf("BrowseCallBackFunc")
End If
End With
'Display the dialog
pidl = SHBrowseForFolder(bInfo)
'Get path string from pidl
GetDirectory = GetPathFromID(pidl)
CoTaskMemFree pidl
LocalFree lpInitDir
End Function

'Windows calls this function when the dialog events occur
Function BrowseCallBackFunc(ByVal hwnd As Long, ByVal Msg As Long, ByVal lParam As Long, ByVal pData As Long) As Long
Select Case Msg
Case BFFM_INITIALIZED
'Dialog is being initialized. I use this to set the initial directory and to center the dialog if the requested
SendMessage hwnd, BFFM_SETSELECTIONA, 1, pData 'Send message to dialog
If CntrDialog Then CenterDialog hwnd
Case BFFM_SELCHANGED
'User selected a folder - change status text ("show status text" option must be set to see this)
SendMessage hwnd, BFFM_SETSTATUSTEXTA, 0, GetPathFromID(lParam)
Case BFFM_VALIDATEFAILED
'This message is sent to the callback function only if "Allow direct entry" and
'"Validate direct entry" have been be set on the Demo worksheet
'and the user's direct entry is not valid.
'"Show status text" must be set on to see error message we send back to the dialog
Beep
SendMessage hwnd, BFFM_SETSTATUSTEXTA, 0, "Bad Directory"
BrowseCallBackFunc = 1 'Block dialog closing
Exit Function
End Select
BrowseCallBackFunc = 0 'Allow dialog to close
End Function

'Converts a PIDL to a string
Function GetPathFromID(ID As Long) As String
    Dim Result As Boolean, Path As String * MAX_PATH
    Result = SHGetPathFromIDList(ID, Path)
    If Result Then
        GetPathFromID = Left(Path, InStr(Path, Chr$(0)) - 1)
    Else
        GetPathFromID = ""
    End If
End Function

'XL8 is very unhappy about using Excel 9's AddressOf operator, but as long as it is in a
' function that is not called when run on XL8, it seems to allow it to exist.
Function BrowseCallBackFuncAddress() As Long
BrowseCallBackFuncAddress = Long2Long(AddressOf BrowseCallBackFunc)
End Function

'It is not possible to assign the result of AddressOf (which is a Long) directly to a member
'of a user defined data type. This explicitly "converts" it to a Long and
'allows the assignment
Function Long2Long(x As Long) As Long
Long2Long = x
End Function

'Centers dialog on desktop
Sub CenterDialog(hwnd As Long)
Dim WinRect As RECT, ScrWidth As Integer, ScrHeight As Integer
Dim DlgWidth As Integer, DlgHeight As Integer
GetWindowRect hwnd, WinRect
DlgWidth = WinRect.Right - WinRect.Left
DlgHeight = WinRect.Bottom - WinRect.Top
ScrWidth = GetSystemMetrics(SM_CXFULLSCREEN)
ScrHeight = GetSystemMetrics(SM_CYFULLSCREEN)
MoveWindow hwnd, (ScrWidth - DlgWidth) / 2, (ScrHeight - DlgHeight) / 2, DlgWidth, DlgHeight, 1
End Sub

---------------------------------------------------------------------------------
A second module (which happens to be called basAddrOf)
Option Explicit

'NOTE: The brilliant AddrOf function herein contained is the work of Ken Getz and
'Michael Kaplan. Published in the May 1998 issue of
'Microsoft Office & Visual Basic for Applications Developer (page 46).

'Office 97 does not support the "AddressOf" operator which is needed to tell Windows
'where our "call back" function is. Getz and Kaplan figured out a workaround.

'The rest of this module is entirely their work.

'-------------------------------------------------------------------------------------------------------------------
' Declarations
'
' These function names were puzzled out by using DUMPBIN /exports
' with VBA332.DLL and then puzzling out parameter names and types
' through a lot of trial and error and over 100 IPFs in MSACCESS.EXE
' and VBA332.DLL.
'
' These parameters may not be named properly but seem to be correct in
' light of the function names and what each parameter does.
'
' EbGetExecutingProj: Gives you a handle to the current VBA project
' TipGetFunctionId: Gives you a function ID given a function name
' TipGetLpfnOfFunctionId: Gives you a pointer a function given its function ID
'
'-------------------------------------------------------------------------------------------------------------------
Private Declare Function GetCurrentVbaProject _
Lib "vba332.dll" Alias "EbGetExecutingProj" _
(hProject As Long) As Long
Private Declare Function GetFuncID _
Lib "vba332.dll" Alias "TipGetFunctionId" _
(ByVal hProject As Long, ByVal strFunctionName As String, _
ByRef strFunctionId As String) As Long
Private Declare Function GetAddr _
Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _
(ByVal hProject As Long, ByVal strFunctionId As String, _
ByRef lpfn As Long) As Long

'-------------------------------------------------------------------------------------------------------------------
' AddrOf
'
' Returns a function pointer of a VBA public function given its name. This function
' gives similar functionality to VBA as VB5 has with the AddressOf param type.
'
' NOTE: This function only seems to work if the proc you are trying to get a pointer
' to is in the current project. This makes sense, since we are using a function
' named EbGetExecutingProj.
'-------------------------------------------------------------------------------------------------------------------
Public Function AddrOf(strFuncName As String) As Long
Dim hProject As Long
Dim lngResult As Long
Dim strID As String
Dim lpfn As Long
Dim strFuncNameUnicode As String

    Const NO_ERROR = 0

    ' The function name must be in Unicode, so convert it.
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)

' Get the current VBA project
' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
' so now we just check the project handle when the function returns.
Call GetCurrentVbaProject(hProject)

' Make sure we got a project handle... we always should, but you never know!
If hProject <> 0 Then
' Get the VBA function ID (whatever that is!)
lngResult = GetFuncID( _
hProject, strFuncNameUnicode, strID)

' We have to check this because we GPF if we try to get a function pointer
' of a non-existent function.
If lngResult = NO_ERROR Then
' Get the function pointer.
lngResult = GetAddr(hProject, strID, lpfn)

            If lngResult = NO_ERROR Then
                AddrOf = lpfn
            End If
        End If
    End If
End Function







prepotency wrote: 
Yes exactly.  I guess my question in the OP was referring to the file
parsing method which uses the least memory (time taken to run).  I had
considered using split or Mid but what we're really trying to get
around here is reading in the whole file.  Furthermore with Split, it
takes so much time because it parses the whole file and writes its
contents into an array (the creation of the array is what takes so
long).  With the Mid option, we are still forced to read on the whole
file.  Here's a question: when you read in line by line does VBA still
open the whole file?  I guess that's what I'm wondering.  Because I
don't really want to open up the whole file.  I just assumed that it
opened the whole file into ram and then started pulling the lines out
of it, which wouldn't necessarily save you any time.

Question:  What's the fastest way to tab through every file in a
specified folder and how do you allow the user to browse and select a
folder (NOT a file)?  Nagging question I was having.

G


.

Relevant Pages

  • browse for folder code
    ... - to supply a starting folder ... pszDisplayName As String ... Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _ ... "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _ ...
    (microsoft.public.access.modulesdaovba)
  • List of File Names in a folder
    ... I have a way for the user to choose the folder. ... Dim strFolderName As String ... Private Type BROWSEINFO ... Private Declare Function SHGetPathFromIDList ...
    (microsoft.public.access.modulesdaovba)
  • Re: InStrRev
    ... Ran the program on a single folder with 268 *.jpg pictures in that folder. ... Private Declare Function SHGetPathFromIDList _ ... ByVal sDir As String) As Long ... Dim bInf As BrowseInfo ...
    (microsoft.public.vb.general.discussion)
  • RE: browse for folder code
    ... Function GetFolderPathAs String ... If Not Folder Is Nothing Then ... Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _ ... "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _ ...
    (microsoft.public.access.modulesdaovba)
  • Re: FileListBox and directories with more than 32,768 files!
    ... Here is an example that allows you to select a folder and it then simply counts the number of files and folders within that folder ... fileName As String * MAX_PATH ... Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ ... Dim browse_info As BrowseInfo ...
    (comp.lang.basic.visual.misc)