Hi Mark,
'From A Code A Day, March 2, 2000 - Guest Author Frank Zander'
GUEST AUTHOR
Frank Zander
In yesterday's letter I provided a solution for setting the common dialog to
accept multiple file selections, and then a method to place all of the file
names into a list box. Frank Zander offers this VERY nice solution that
trims back the amount of code used and places the filenames directly into
the list box (rather than into an array then into the list box) Frank has a
great site that you can visit for information and examples on VBA and VB
programming:
http://www.contractcaddgroup.com (Mark, you really should stop by Frank's
site, there are some great utilities there!)
Take it away Frank,
This solution returns the Path and file name information to a list box
Name the CommonDialog as CommonDialog1 and the list box as lstPrograms
Private Sub cmdADD_Click()
Dim SelectedFiles As Variant
Dim myPos As Integer
Dim myDir As String
Dim strFileName As String
Dim strFiles As String
Dim strPath As String
On Error GoTo ErrHandler
' empty the filename in the dialog box
CommonDialog1.DialogTitle = "Select AutoCAD Appllications arx, lsp, dvb,
dbx, vlx or fas Files"
CommonDialog1.FileName = ""
CommonDialog1.MaxFileSize = 32000
CommonDialog1.Filter = "AutoCAD Apps
(*.arx;*.lsp;*.dvb;*.dbx;*.vlx;*.fas)|*.arx;*.lsp;*.dvb;*.dbx;*.vlx;*.fas|AR
X (*.arx)|*.arx|VBA projects (*.dvb)|*.dvb|Dialogue Control
(*.dcl)|*.dcl|All Files (*.*)|*.*"
CommonDialog1.DefaultExt = "*.lsp"
CommonDialog1.FilterIndex = 1
' Set Cancel to True.
CommonDialog1.CancelError = True
' allow multi select = cdlOFNAllowMultiselect
' long filenames = cdlOFNLongNames
' explorer interface = cdlOFNExplorer
CommonDialog1.Flags = cdlOFNAllowMultiselect + cdlOFNExplorer +
cdlOFNNoDereferenceLinks + cdlOFNPathMustExist + cdlOFNHideReadOnly
' set the dialogbox to show open
CommonDialog1.ShowOpen
strFiles = CommonDialog1.FileName
strFileName = CommonDialog1.FileName
If InStr(strFileName, Chr$(0)) > 0 Then
strPath = Mid(strFiles, 1, InStr(strFiles, Chr$(0)) - 1)
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
While InStr(strFiles, Chr$(0)) > 0
strFiles = Right(strFiles, Len(strFiles) - InStr(strFiles, Chr$(0)))
' Debug.Print strFiles
If InStr(strFiles, Chr$(0)) > 0 Then
strFileName = Mid(strFiles, 1, InStr(strFiles, Chr$(0)) - 1)
Else
strFileName = strFiles
End If
lstPrograms.AddItem strPath & strFileName
Wend
Else
lstPrograms.AddItem strFileName
End If
' Exit Sub
ErrHandler:
' User pressed Cancel button.
Exit Sub
End Sub
That's the end of that article - Now, how about skipping that whole nasty
common dialog control? Here is a class module and a calling sub that will
get you the name of a single file:
o--------------- FileDialog
'be sure to name the class FileDialog
Option Explicit
'//The Win32 API Functions///
Private Declare Function GetSaveFileName Lib _
"comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetOpenFileName Lib _
"comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
'//A few of the available Flags///
Private Const OFN_HIDEREADONLY = &H4
'//The Structure
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private lngHwnd As Long
Private strFilter As String
Private strTitle As String
Private strDir As String
Private blnHideReadOnly As Boolean
Private Sub Class_Initialize()
'Set default values when
'class is first created
strDir = CurDir
strTitle = "Llamas Rule"
strFilter = "All Files" _
& Chr$(0) & "*.*" & Chr$(0)
lngHwnd = &O0 'Desktop
End Sub
Public Property Let OwnerHwnd(WindowHandle As Long)
'//FOR YOU TODO//
'Use the API to validate this handle
lngHwnd = WindowHandle
'R14 users who just want to use this code:
'Simple, don't set this property! the default
'of &0 will work fine for most of yor needs
End Property
Public Property Get OwnerHwnd() As Long
OwnerHwnd = lngHwnd
End Property
Public Property Let Title(Caption As String)
'don't allow null strings
If Not Caption = vbNullString Then
strTitle = Caption
End If
End Property
Public Property Get Title() As String
Title = strTitle
End Property
Public Property Let Filter(ByVal FilterString As String)
'Filters change the type of files that are
'displayed in the dialog. I have designed this
'validation to use the same filter format the
'Common dialog OCX uses:
'"All Files (*.*)|*.*"
Dim intPos As Integer
Do While InStr(FilterString, "|") > 0
intPos = InStr(FilterString, "|")
If intPos > 0 Then
FilterString = Left$(FilterString, intPos - 1) _
& Chr$(0) & Right$(FilterString, _
Len(FilterString) - intPos)
End If
Loop
If Right$(FilterString, 2) <> Chr$(0) & Chr$(0) Then
FilterString = FilterString & Chr$(0)
End If
strFilter = FilterString
End Property
Public Property Get Filter() As String
'Here we reverse the process and return
'the Filter in the same format the it was
'entered
Dim intPos As Integer
Dim strTemp As String
strTemp = strFilter
Do While InStr(strTemp, Chr$(0)) > 0
intPos = InStr(strTemp, Chr$(0))
If intPos > 0 Then
strTemp = Left$(strTemp, intPos - 1) _
& "|" & Right$(strTemp, _
Len(strTemp) - intPos)
End If
Loop
If Right$(strTemp, 1) = "|" Then
strTemp = Left$(strTemp, Len(strTemp) - 1)
End If
Filter = strTemp
End Property
Public Property Let HideReadOnly(blnVal As Boolean)
'Simple one
blnHideReadOnly = blnVal
End Property
Public Property Get HideReadOnly() As Boolean
HideReadOnly = blnHideReadOnly
End Property
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File open dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
Public Function ShowOpen() As String
Dim strTemp As String
Dim udtStruct As OPENFILENAME
udtStruct.lStructSize = Len(udtStruct)
'Use our private variable
udtStruct.hwndOwner = lngHwnd
'Use our private variable
udtStruct.lpstrFilter = strFilter
udtStruct.lpstrFile = Space$(254)
udtStruct.nMaxFile = 255
udtStruct.lpstrFileTitle = Space$(254)
udtStruct.nMaxFileTitle = 255
'Use our private variable
udtStruct.lpstrInitialDir = strDir
'Use our private variable
udtStruct.lpstrTitle = strTitle
'Ok, here we test our boolean to
'set the flag
If blnHideReadOnly Then
udtStruct.flags = OFN_HIDEREADONLY
Else
udtStruct.flags = 0
End If
If GetOpenFileName(udtStruct) Then
strTemp = (Trim(udtStruct.lpstrFile))
ShowOpen = Mid(strTemp, 1, Len(strTemp) - 1)
End If
End Function
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File Save dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
Public Function ShowSave() As String
Dim strTemp As String
Dim udtStruct As OPENFILENAME
udtStruct.lStructSize = Len(udtStruct)
'Use our private variable
udtStruct.hwndOwner = lngHwnd
'Use our private variable
udtStruct.lpstrFilter = strFilter
udtStruct.lpstrFile = Space$(254)
udtStruct.nMaxFile = 255
udtStruct.lpstrFileTitle = Space$(254)
udtStruct.nMaxFileTitle = 255
'Use our private variable
udtStruct.lpstrInitialDir = strDir
'Use our private variable
udtStruct.lpstrTitle = strTitle
'Ok, here we test our flag
If blnHideReadOnly Then
udtStruct.flags = OFN_HIDEREADONLY
Else
udtStruct.flags = 0
End If
If GetSaveFileName(udtStruct) Then
strTemp = (Trim(udtStruct.lpstrFile))
ShowSave = Mid(strTemp, 1, Len(strTemp) - 1)
End If
End Function
o------------- the call that sets it in motion
Public Sub DialogTest()
Dim strFile As String
Dim objDialog As FileDialog
Set objDialog = New FileDialog
objDialog.HideReadOnly = True
objDialog.Filter = "Text Files (*.txt)|*.txt"
objDialog.OwnerHwnd = ThisDrawing.HWND
objDialog.Title = "Sample Dialog"
strFile = objDialog.ShowOpen
MsgBox strFile
Set objDialog = Nothing
End Sub
Randall Rath