<font color=#0,0,ff>Option Explicit
Declare Function</font><font color=#0,0,0> GetOpenFileName</font><font color=#0,0,ff> Lib</font><font color=#0,0,0> "comdlg32.dll"</font><font color=#0,0,ff> Alias</font><font color=#0,0,0> "GetOpenFileNameA" (pOpenfilename</font><font color=#0,0,ff> As</font><font color=#0,0,0> OPENFILENAME)</font><font color=#0,0,ff> As Long
Declare Function</font><font color=#0,0,0> GetSaveFileName</font><font color=#0,0,ff> Lib</font><font color=#0,0,0> "comdlg32.dll"</font><font color=#0,0,ff> Alias</font><font color=#0,0,0> "GetSaveFileNameA" (pOpenfilename</font><font color=#0,0,ff> As</font><font color=#0,0,0> OPENFILENAME)</font><font color=#0,0,ff> As Long
Type</font><font color=#0,0,0> MSA_OPENFILENAME</font><font color=#0,80,0>
' Filter string used for the File Open dialog filters.
' Use MSA_CreateFilterString() to create this.
' Default = All Files, *.*
</font><font color=#0,0,0> strFilter</font><font color=#0,0,ff> As String</font><font color=#0,80,0>
' Initial Filter to display.
' Default = 1.
</font><font color=#0,0,0> lngFilterIndex</font><font color=#0,0,ff> As Long</font><font color=#0,80,0>
' Initial directory for the dialog to open in.
' Default = Current working directory.
</font><font color=#0,0,0> strInitialDir</font><font color=#0,0,ff> As String</font><font color=#0,80,0>
' Initial file name to populate the dialog with.
' Default = ".
</font><font color=#0,0,0> strInitialFile</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
strDialogTitle</font><font color=#0,0,ff> As String</font><font color=#0,80,0>
' Default extension to append to file if user didn't specify one.
' Default = System Values (Open File, Save File).
</font><font color=#0,0,0> strDefaultExtension</font><font color=#0,0,ff> As String</font><font color=#0,80,0>
' Flags (see constant list) to be used.
' Default = no flags.
</font><font color=#0,0,0> lngFlags</font><font color=#0,0,ff> As Long</font><font color=#0,80,0>
' Full path of file picked. On OpenFile, if the user picks a
' nonexistent file, only the text in the 'File Name' box is returned.
</font><font color=#0,0,0> strFullPathReturned</font><font color=#0,0,ff> As String</font><font color=#0,80,0>
' File name of file picked.
</font><font color=#0,0,0> strFileNameReturned</font><font color=#0,0,ff> As String</font><font color=#0,80,0>
' Offset in full path (strFullPathReturned) where the file name
' (strFileNameReturned) begins.
</font><font color=#0,0,0> intFileOffset</font><font color=#0,0,ff> As Integer</font><font color=#0,80,0>
' Offset in full path (strFullPathReturned) where the file extension begins.
</font><font color=#0,0,0> intFileExtension</font><font color=#0,0,ff> As Integer
End Type
Const</font><font color=#0,0,0> ALLFILES = "All Files"</font><font color=#0,0,ff>
Type</font><font color=#0,0,0> OPENFILENAME
lStructSize</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
hwndOwner</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
hInstance</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
lpstrFilter</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
lpstrCustomFilter</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
nMaxCustrFilter</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
nFilterIndex</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
lpstrFile</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
nMaxFile</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
lpstrFileTitle</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
nMaxFileTitle</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
lpstrInitialDir</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
lpstrTitle</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
flags</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
nFileOffset</font><font color=#0,0,ff> As Integer</font><font color=#0,0,0>
nFileExtension</font><font color=#0,0,ff> As Integer</font><font color=#0,0,0>
lpstrDefExt</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
lCustrData</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
lpfnHook</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
lpTemplateName</font><font color=#0,0,ff> As Long
End Type
Const</font><font color=#0,0,0> OFN_ALLOWMULTISELECT = &H200</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_CREATEPROMPT = &H2000</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_EXPLORER = &H80000</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_FILEMUSTEXIST = &H1000</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_HIDEREADONLY = &H4</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_NOCHANGEDIR = &H8</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_NODEREFERENCELINKS = &H100000</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_NONETWORKBUTTON = &H20000</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_NOREADONLYRETURN = &H8000</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_NOVALIDATE = &H100</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_OVERWRITEPROMPT = &H2</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_PATHMUSTEXIST = &H800</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_READONLY = &H1</font><font color=#0,0,ff>
Const</font><font color=#0,0,0> OFN_SHOWHELP = &H10</font><font color=#0,0,ff>
Type</font><font color=#0,0,0> BROWSEINFO
hwndOwner</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
pidlRoot</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
pszDisplayName</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
lpszTitle</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
ulFlags</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
lpfn</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
lParam</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
iImage</font><font color=#0,0,ff> As Long
End Type
Declare Function</font><font color=#0,0,0> SHBrowseForFolder</font><font color=#0,0,ff> Lib</font><font color=#0,0,0> "shell32.dll"</font><font color=#0,0,ff> Alias</font><font color=#0,0,0> "SHBrowseForFolderA" (ByRef lpBrInf</font><font color=#0,0,ff> As</font><font color=#0,0,0> BROWSEINFO)</font><font color=#0,0,ff> As Long
Declare Function</font><font color=#0,0,0> SHGetPathFromIDList</font><font color=#0,0,ff> Lib</font><font color=#0,0,0> "shell32.dll"</font><font color=#0,0,ff> Alias</font><font color=#0,0,0> "SHGetPathFromIDListA" (</font><font color=#0,0,ff>ByVal</font><font color=#0,0,0> pidl</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>,</font><font color=#0,0,ff> ByVal</font><font color=#0,0,0> pszPath</font><font color=#0,0,ff> As String</font><font color=#0,0,0>)</font><font color=#0,0,ff> As Long</font><font color=#0,0,0>
Public</font><font color=#0,0,ff> Function</font><font color=#0,0,0> BrowseForFolder(capt</font><font color=#0,0,ff> As String</font><font color=#0,0,0>, Optional hwnd</font><font color=#0,0,ff> As Long</font><font color=#0,0,0> =</font><font color=#80,0,0> 0</font><font color=#0,0,0>)</font><font color=#0,0,ff> As String
Dim</font><font color=#0,0,0> brInf</font><font color=#0,0,ff> As</font><font color=#0,0,0> BROWSEINFO</font><font color=#0,0,ff>
Dim</font><font color=#0,0,0> lRet</font><font color=#0,0,ff> As Long
Dim</font><font color=#0,0,0> Path</font><font color=#0,0,ff> As String</font><font color=#0,0,0> *</font><font color=#80,0,0> 256</font><font color=#0,0,ff>
On Error GoTo</font><font color=#0,0,0> BrowseForFolder_ERROR_HANDLER
BrowseForFolder = ""</font><font color=#0,80,0>
'path = String$(512, 0)
</font><font color=#0,0,0>
brInf.hwndOwner = hwnd
brInf.pidlRoot =</font><font color=#80,0,0> 0</font><font color=#0,0,0>
brInf.pszDisplayName =</font><font color=#0,0,ff> String</font><font color=#80,0,0>$</font><font color=#0,0,0>(</font><font color=#80,0,0>512</font><font color=#0,0,0>,</font><font color=#80,0,0> 0</font><font color=#0,0,0>)
brInf.lpszTitle = capt
brInf.ulFlags =</font><font color=#80,0,0> 1</font><font color=#0,0,0>
brInf.lpfn =</font><font color=#80,0,0> 0</font><font color=#0,0,0>
brInf.lParam =</font><font color=#80,0,0> 0</font><font color=#0,0,0>
brInf.iImage =</font><font color=#80,0,0> 0</font><font color=#0,0,0>
lRet = SHBrowseForFolder(brInf)</font><font color=#0,0,ff>
If</font><font color=#0,0,0> lRet <></font><font color=#80,0,0> 0</font><font color=#0,0,ff> Then
If</font><font color=#0,0,0> SHGetPathFromIDList(lRet, Path) <></font><font color=#80,0,0> 0</font><font color=#0,0,ff> Then</font><font color=#0,0,0>
BrowseForFolder =</font><font color=#0,0,ff> Left</font><font color=#0,0,0>(Path,</font><font color=#0,0,ff> InStr</font><font color=#0,0,0>(</font><font color=#80,0,0>1</font><font color=#0,0,0>, Path,</font><font color=#0,0,ff> Chr</font><font color=#0,0,0>(</font><font color=#80,0,0>0</font><font color=#0,0,0>), vbBinaryCompare) -</font><font color=#80,0,0> 1</font><font color=#0,0,0>)</font><font color=#0,0,ff>
End If
End If
Exit Function</font><font color=#0,0,0>
BrowseForFolder_ERROR_HANDLER:
ErrorHandler "BrowseForFolder"</font><font color=#0,0,ff>
End Function
Private Sub</font><font color=#0,0,0> OF_to_MSAOF(of</font><font color=#0,0,ff> As</font><font color=#0,0,0> OPENFILENAME, msaof</font><font color=#0,0,ff> As</font><font color=#0,0,0> MSA_OPENFILENAME)</font><font color=#0,80,0>
' This sub converts from the win32 structure to the friendly MSAccess structure.
</font><font color=#0,0,0>
msaof.strFullPathReturned =</font><font color=#0,0,ff> Left</font><font color=#80,0,0>$</font><font color=#0,0,0>(of.lpstrFile,</font><font color=#0,0,ff> InStr</font><font color=#0,0,0>(of.lpstrFile,</font><font color=#0,0,ff> Chr</font><font color=#80,0,0>$</font><font color=#0,0,0>(</font><font color=#80,0,0>0</font><font color=#0,0,0>)))
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension</font><font color=#0,0,ff>
End Sub
Private Sub</font><font color=#0,0,0> MSAOF_to_OF(msaof</font><font color=#0,0,ff> As</font><font color=#0,0,0> MSA_OPENFILENAME, of</font><font color=#0,0,ff> As</font><font color=#0,0,0> OPENFILENAME, Optional hwnd</font><font color=#0,0,ff> As Long</font><font color=#0,0,0> =</font><font color=#80,0,0> 0</font><font color=#0,0,0>)</font><font color=#0,80,0>
' This sub converts from the friendly MSAccess structure to the win32 structure.
</font><font color=#0,0,ff> Dim</font><font color=#0,0,0> strFile</font><font color=#0,0,ff> As String</font><font color=#0,0,0> *</font><font color=#80,0,0> 512</font><font color=#0,80,0>
' Initialize some parts of the structure.
</font><font color=#0,0,0>
of.hwndOwner = hwnd
of.hInstance =</font><font color=#80,0,0> 0</font><font color=#0,0,0>
of.lpstrCustomFilter =</font><font color=#80,0,0> 0</font><font color=#0,0,0>
of.nMaxCustrFilter =</font><font color=#80,0,0> 0</font><font color=#0,0,0>
of.lpfnHook =</font><font color=#80,0,0> 0</font><font color=#0,0,0>
of.lpTemplateName =</font><font color=#80,0,0> 0</font><font color=#0,0,0>
of.lCustrData =</font><font color=#80,0,0> 0</font><font color=#0,0,ff>
If</font><font color=#0,0,0> msaof.strFilter = ""</font><font color=#0,0,ff> Then</font><font color=#0,0,0>
of.lpstrFilter = MSA_CreateFilterString(ALLFILES, "*.*")</font><font color=#0,0,ff>
Else</font><font color=#0,0,0>
of.lpstrFilter = msaof.strFilter</font><font color=#0,0,ff>
End If</font><font color=#0,0,0>
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile &</font><font color=#0,0,ff> String</font><font color=#80,0,0>$</font><font color=#0,0,0>(</font><font color=#80,0,0>512</font><font color=#0,0,0> -</font><font color=#0,0,ff> Len</font><font color=#0,0,0>(msaof.strInitialFile),</font><font color=#80,0,0> 0</font><font color=#0,0,0>)
of.nMaxFile =</font><font color=#80,0,0> 511</font><font color=#0,0,0>
of.lpstrFileTitle =</font><font color=#0,0,ff> String</font><font color=#80,0,0>$</font><font color=#0,0,0>(</font><font color=#80,0,0>512</font><font color=#0,0,0>,</font><font color=#80,0,0> 0</font><font color=#0,0,0>)
of.nMaxFileTitle =</font><font color=#80,0,0> 511</font><font color=#0,0,0>
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize =</font><font color=#0,0,ff> Len</font><font color=#0,0,0>(of)</font><font color=#0,0,ff>
End Sub
Private Function</font><font color=#0,0,0> MSA_GetOpenFileName(msaof</font><font color=#0,0,ff> As</font><font color=#0,0,0> MSA_OPENFILENAME)</font><font color=#0,0,ff> As Integer</font><font color=#0,80,0>
' Opens the file open dialog.
</font><font color=#0,0,ff>
Dim</font><font color=#0,0,0> of</font><font color=#0,0,ff> As</font><font color=#0,0,0> OPENFILENAME</font><font color=#0,0,ff>
Dim</font><font color=#0,0,0> intRet</font><font color=#0,0,ff> As Integer</font><font color=#0,0,0>
MSAOF_to_OF msaof, of
intRet = GetOpenFileName(of)</font><font color=#0,0,ff>
If</font><font color=#0,0,0> intRet</font><font color=#0,0,ff> Then</font><font color=#0,0,0>
OF_to_MSAOF of, msaof</font><font color=#0,0,ff>
End If</font><font color=#0,0,0>
MSA_GetOpenFileName = intRet</font><font color=#0,0,ff>
End Function
Private Function</font><font color=#0,0,0> MSA_GetSaveFileName(msaof</font><font color=#0,0,ff> As</font><font color=#0,0,0> MSA_OPENFILENAME)</font><font color=#0,0,ff> As Integer
Dim</font><font color=#0,0,0> of</font><font color=#0,0,ff> As</font><font color=#0,0,0> OPENFILENAME</font><font color=#0,0,ff>
Dim</font><font color=#0,0,0> intRet</font><font color=#0,0,ff> As Integer</font><font color=#0,0,0>
MSAOF_to_OF msaof, of
intRet = GetSaveFileName(of)</font><font color=#0,0,ff>
If</font><font color=#0,0,0> intRet</font><font color=#0,0,ff> Then</font><font color=#0,0,0>
OF_to_MSAOF of, msaof</font><font color=#0,0,ff>
End If</font><font color=#0,0,0>
MSA_GetSaveFileName = intRet</font><font color=#0,0,ff>
End Function
Private Function</font><font color=#0,0,0> MSA_CreateFilterString(varFilt</font><font color=#0,0,ff> As String</font><font color=#0,0,0>, ext</font><font color=#0,0,ff> As String</font><font color=#0,0,0>)</font><font color=#0,0,ff> As String</font><font color=#0,80,0>
' Creates a filter string from the passed in arguments.
' Returns " if no args are passed in.
' Expects an even number of args (filter name, extension), but
' if an odd number is passed in, it appends *.*
</font><font color=#0,0,ff>
Dim</font><font color=#0,0,0> strFilter</font><font color=#0,0,ff> As String</font><font color=#0,0,0>
strFilter = strFilter & varFilt &</font><font color=#0,0,ff> Chr</font><font color=#80,0,0>$</font><font color=#0,0,0>(</font><font color=#80,0,0>0</font><font color=#0,0,0>) & ext &</font><font color=#0,0,ff> Chr</font><font color=#80,0,0>$</font><font color=#0,0,0>(</font><font color=#80,0,0>0</font><font color=#0,0,0>) &</font><font color=#0,0,ff> Chr</font><font color=#0,0,0>(</font><font color=#80,0,0>0</font><font color=#0,0,0>)
MSA_CreateFilterString = strFilter</font><font color=#0,0,ff>
End Function</font><font color=#0,80,0>
' INPUT : start path
' file types, like 'Text files'
' extension
' title of dialog
' OUTPUT : path and file name like 'C:\Winnt\file.txt'
'Example : OpenFile("C:\","Text Files","*.txt","Select Text File")
</font><font color=#0,0,ff>Function</font><font color=#0,0,0> OpenFile(strSearchPath,</font><font color=#0,0,ff> Name As String</font><font color=#0,0,0>, exten</font><font color=#0,0,ff> As String</font><font color=#0,0,0>, DialogTitle</font><font color=#0,0,ff> As String</font><font color=#0,0,0>)</font><font color=#0,0,ff> As String
Dim</font><font color=#0,0,0> msaof</font><font color=#0,0,ff> As</font><font color=#0,0,0> MSA_OPENFILENAME
msaof.strDialogTitle = DialogTitle
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString(</font><font color=#0,0,ff>Name</font><font color=#0,0,0>, exten)
MSA_GetOpenFileName msaof
OpenFile =</font><font color=#0,0,ff> Trim</font><font color=#0,0,0>(msaof.strFullPathReturned)</font><font color=#0,0,ff>
If</font><font color=#0,0,0> OpenFile = ""</font><font color=#0,0,ff> Then</font><font color=#0,0,0>
OpenFile =</font><font color=#0,0,ff> Chr</font><font color=#0,0,0>(</font><font color=#80,0,0>0</font><font color=#0,0,0>)</font><font color=#0,0,ff>
Else</font><font color=#0,0,0>
OpenFile =</font><font color=#0,0,ff> Mid</font><font color=#0,0,0>(OpenFile,</font><font color=#80,0,0> 1</font><font color=#0,0,0>,</font><font color=#0,0,ff> Len</font><font color=#0,0,0>(OpenFile) -</font><font color=#80,0,0> 1</font><font color=#0,0,0>)</font><font color=#0,0,ff>
End If
End Function</font><font color=#0,80,0>
' INPUT : start path
' file types, like 'Text files'
' extension
' title of dialog
' OUTPUT : path and file name like 'C:\Winnt\file.txt'
'Example : SaveFile("C:\","Text Files","*.txt","Select Text File")
</font><font color=#0,0,ff>Function</font><font color=#0,0,0> SaveFile(strSearchPath,</font><font color=#0,0,ff> Name As String</font><font color=#0,0,0>, exten</font><font color=#0,0,ff> As String</font><font color=#0,0,0>, DialogTitle</font><font color=#0,0,ff> As String</font><font color=#0,0,0>)</font><font color=#0,0,ff> As String
Dim</font><font color=#0,0,0> msaof</font><font color=#0,0,ff> As</font><font color=#0,0,0> MSA_OPENFILENAME
msaof.strDialogTitle = DialogTitle
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString(</font><font color=#0,0,ff>Name</font><font color=#0,0,0>, exten)
MSA_GetSaveFileName msaof
SaveFile =</font><font color=#0,0,ff> Trim</font><font color=#0,0,0>(msaof.strFullPathReturned)</font><font color=#0,0,ff>
If</font><font color=#0,0,0> SaveFile = ""</font><font color=#0,0,ff> Then</font><font color=#0,0,0>
SaveFile =</font><font color=#0,0,ff> Chr</font><font color=#0,0,0>(</font><font color=#80,0,0>0</font><font color=#0,0,0>)</font><font color=#0,0,ff>
Else</font><font color=#0,0,0>
SaveFile =</font><font color=#0,0,ff> Mid</font><font color=#0,0,0>(SaveFile,</font><font color=#80,0,0> 1</font><font color=#0,0,0>,</font><font color=#0,0,ff> Len</font><font color=#0,0,0>(SaveFile) -</font><font color=#80,0,0> 1</font><font color=#0,0,0>)
SaveFile = SaveFile & "." &</font><font color=#0,0,ff> Mid</font><font color=#0,0,0>(exten,</font><font color=#80,0,0> 3</font><font color=#0,0,0>)</font><font color=#0,0,ff>
End If
End Function</font><font color=#0,0,0>
</font>
Martin
--------------------------------------------
C'mon we all know computers are experimental devices and should only be used for playing games.
Using them for alternative stuff like business, is clearly not using them for what they are intended.
Colin Davies
|