This code is a bit advanced but it will allow you to pick the files you want. It will even allow you show only TEXT or XL files.
Create a module to put this code in....(easy) but the Commondialog at the bottom is a bit harder)
Code:
''dont forget the common dialog class
Public Sub Pick1File()
Dim vFileType, vFile
'use vFileType = "T" for text
'use vFileType = "X" for excel
'vFileType = cboFileType
vFile = UserPickFile("X") 'T or X
If vFile <> "" Then
'use this file to open
End If
End Sub
Public Function UserPickFile(ByVal pvFilter, Optional pvPath)
Dim clsCmn As New cCommonDialog
Dim vFile
'If IsNull(pvPath) Then pvPath = getMyDocs
'If IsMissing(pvPath) Then pvPath = getMyDocs
With clsCmn
.DialogTitle = "Set Input File"
'.InitDir = pvPath
.FilterCode = pvFilter
.ShowOpen
UserPickFile = .FileName
End With
Set clsCmn = Nothing
End Function
NEXT...create a CLASS module..paste the code below into it AND IT MUST BE NAMED cCommonDialog (or it wont work)
Code:
Option Explicit
Private Const mkCLASSNAME = "cCommonDialog"
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Const cdlAPIcancel = 32755
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
' OFN_SHAREWARN = &H0
' OFN_SHARENOWARN = &H1
' OFN_SHAREFALLTHROUGH = &H2
'Public Enum OFN_Flags
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFS_MAXPATHNAME = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_EXPLORER = &H80000
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000
'End Enum
'local variable(s) to hold property value(s)
Private mvFilterCode
Private mvarCancelError As Boolean
Private mvarDefaultExt As String
Private mvarDialogTitle As String
Private mvarFileName As String
Private mvarFileTitle As String
Private mvarFilterIndex As Integer
Private mvarFilter As String
Private mvarFlags As Long
Private mvarInitDir As String
Private mvarMaxFileSize As Integer
Private mvarhWnd As Long
Private mvarFileExt As Integer
Public Property Let FileExt(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FileExt = 5
mvarFileExt = vData
End Property
Public Property Get FileExt() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FileExt
FileExt = mvarFileExt
End Property
Public Property Let hwnd(ByVal vData As Long)
' The owner of the window
' Default: 0
mvarhWnd = vData
End Property
Public Property Get hwnd() As Long
hwnd = mvarhWnd
End Property
Public Sub ShowSave()
Dim ofn As OPENFILENAME
Dim retval As Long
With ofn
.Flags = Flags
.hwndOwner = hwnd
.hInstance = 0
.lCustData = 0
.lpfnHook = 0
' .lpstrCustomFilter = vbNullChar 'Removed for NT compatibility problems
.lpstrDefExt = DefaultExt
.lpstrFile = mvarFileName & String$(MaxFileSize - Len(FileName) + 1, vbNullChar)
.lpstrFileTitle = FileTitle & Space$(256)
.lpstrFilter = mvarFilter
.lpstrInitialDir = InitDir
.lpstrTitle = DialogTitle
.lpTemplateName = 0
.lStructSize = Len(ofn)
.nFileExtension = 0
.nFileOffset = 0
.nFilterIndex = FilterIndex
.nMaxCustFilter = 0
.nMaxFile = MaxFileSize
.nMaxFileTitle = 260
End With
retval = GetSaveFileName(ofn)
If retval > 0 Then
With ofn
Flags = .Flags
DefaultExt = .lpstrDefExt
FileName = Trim$(.lpstrFile)
FileTitle = Trim$(.lpstrFileTitle)
FileExt = .nFileExtension
mvarFilter = Trim$(.lpstrFilter)
InitDir = Trim$(.lpstrInitialDir)
FilterIndex = Trim$(.nFilterIndex)
End With
Else
If CancelError Then Err.Raise cdlAPIcancel, "Run-time error", "Cancel was selected"
End If
End Sub
Public Sub ShowOpen()
Dim ofn As OPENFILENAME
Dim retval As Long
With ofn
.Flags = Flags
.hwndOwner = hwnd
.hInstance = 0
.lCustData = 0
.lpfnHook = 0
' .lpstrCustomFilter = vbNullChar ' Removed for NT compatibility problem
.lpstrDefExt = DefaultExt
.lpstrFile = FileName & String$(MaxFileSize - Len(FileName) + 1, 0)
.lpstrFileTitle = FileTitle & Space$(256)
.lpstrFilter = mvarFilter
.lpstrInitialDir = InitDir
.lpstrTitle = mvarDialogTitle 'DialogTitle
.lpTemplateName = 0
.lStructSize = Len(ofn)
.nFileExtension = 0
.nFileOffset = 0
.nFilterIndex = FilterIndex
.nMaxCustFilter = 0
.nMaxFile = MaxFileSize
.nMaxFileTitle = 260
End With
retval = GetOpenFileName(ofn)
If retval > 0 Then
With ofn
Flags = .Flags
DefaultExt = .lpstrDefExt
FileName = Trim$(.lpstrFile)
FileTitle = Trim$(.lpstrFileTitle)
FileExt = .nFileExtension
mvarFilter = Trim$(.lpstrFilter)
InitDir = Trim$(.lpstrInitialDir)
FilterIndex = Trim$(.nFilterIndex)
End With
Else
If CancelError Then Err.Raise cdlAPIcancel, "Run-time error", "Cancel was selected"
End If
End Sub
Public Property Let MaxFileSize(ByVal vData As Integer)
' The maximum length of file name returned
' Default: 260
mvarMaxFileSize = vData
End Property
Public Property Get MaxFileSize() As Integer
MaxFileSize = mvarMaxFileSize
End Property
Public Property Let InitDir(ByVal vData As String)
' Directory to open window in
' Default: "C:\"
mvarInitDir = vData
End Property
Public Property Get InitDir() As String
InitDir = mvarInitDir
End Property
Public Property Let Flags(ByVal vData)
' Flags specifying properties of dialog box
' Default: 0
mvarFlags = vData
End Property
Public Property Get Flags()
Flags = mvarFlags
End Property
Public Property Let Filter(ByVal vData As String)
' Filters that the user can select in drowpdown combo
' Usage: Friendlyname1|*.ex1|Freindlyname2|*.ex2 etc.
' Default: "All Files (*.*)|*.*"
Dim pipepos As String
Do While InStr(vData, "|") > 0
pipepos = InStr(vData, "|")
If pipepos > 0 Then
vData = Left$(vData, pipepos - 1) & vbNullChar & Right$(vData, Len(vData) - pipepos)
End If
Loop
If Right$(vData, 2) <> vbNullChar & vbNullChar Then vData = vData & vbNullChar
If Right$(vData, 2) <> vbNullChar & vbNullChar Then vData = vData & vbNullChar
mvarFilter = vData
End Property
Public Property Get Filter() As String
Dim nullpos As String
Dim tempfilter As String
tempfilter = mvarFilter
Do While InStr(tempfilter, vbNullChar) > 0
nullpos = InStr(tempfilter, vbNullChar)
If nullpos > 0 Then
tempfilter = Left$(tempfilter, nullpos - 1) & vbNullChar & Right$(tempfilter, Len(tempfilter) - nullpos)
End If
Loop
If Right$(tempfilter, 1) = "|" Then tempfilter = Left$(tempfilter, Len(tempfilter) - 1)
If Right$(tempfilter, 1) = "|" Then tempfilter = Left$(tempfilter, Len(tempfilter) - 1)
Filter = tempfilter
End Property
Public Property Let FilterIndex(ByVal vData As Integer)
' Index of filter to select as default
' The first item is 1, second 2, etc.
' Default: 1
mvarFilterIndex = vData
End Property
Public Property Get FilterIndex() As Integer
FilterIndex = mvarFilterIndex
End Property
Public Property Let FileTitle(ByVal vData As String)
' The name of the file without path
mvarFileTitle = vData
End Property
Public Property Get FileTitle() As String
FileTitle = mvarFileTitle
End Property
Public Property Let FileName(ByVal vData As String)
' Name of the file, including path
mvarFileName = vData
End Property
Public Property Get FileName() As String
FileName = Left(mvarFileName, InStr(mvarFileName, Chr(0)))
End Property
Public Property Let DialogTitle(ByVal vData As String)
' The name of the dialog box
mvarDialogTitle = vData
End Property
Public Property Get DialogTitle() As String
DialogTitle = mvarDialogTitle
End Property
Public Property Let DefaultExt(ByVal vData As String)
' The default extension added if one is not specified in the name
mvarDefaultExt = vData
End Property
Public Property Get DefaultExt() As String
DefaultExt = mvarDefaultExt
End Property
Public Property Let CancelError(ByVal vData As Boolean)
' Raise an error if user clicks cancel
' Default: False
mvarCancelError = vData
End Property
Public Property Get CancelError() As Boolean
CancelError = mvarCancelError
End Property
Private Sub Class_Initialize()
CancelError = False
DefaultExt = ""
DialogTitle = ""
FileName = ""
FileTitle = ""
FilterCode = "E"
'Filter = "Access Files (*.mdb)|*.mdb | All Files (*.*)|*.*"
FilterIndex = 1
Flags = OFN_HIDEREADONLY
InitDir = "C:\"
MaxFileSize = 260
hwnd = 0
End Sub
Public Property Get FilterCode() As Variant
FilterCode = mvFilterCode
End Property
Public Property Let FilterCode(ByVal vNewValue As Variant)
mvFilterCode = UCase(vNewValue)
Select Case (mvFilterCode)
Case "A"
Filter = "Access Files (*.mdb)|*.mdb|All Files (*.*)|*.*"
mvarDialogTitle = "Assign Access Database"
Case "C"
Filter = "CSV comma separated text (*.csv)|*.csv|Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
'mvarDialogTitle = "CSV text files"
Case "X"
Filter = "Excel Files (*.xlsm;*.xlsx;*.xls)|*.xlsm;*.xlsx;*.xls|All Files (*.*)|*.*"
mvarDialogTitle = "Excel Workbook"
Case "W"
Filter = "Word Docs (*.doc)|*.doc|All Files (*.*)|*.*"
mvarDialogTitle = "Word document"
Case "J"
Filter = "Jpeg Files (*.jpg)|*.jpg|All Files (*.*)|*.*"
mvarDialogTitle = "Jpeg File"
Case "T"
Filter = "Text Files (*.txt)|*.txt|CSV comma separated text (*.csv)|*.csv|All Files (*.*)|*.*"
'mvarDialogTitle = "Text File"
Case "E"
Filter = "Program Files (*.exe)|*.exe|All Files (*.*)|*.*"
mvarDialogTitle = "Program File"
Case "*"
Filter = "Word Docs (*.doc)|*.doc|Jpeg Files (*.jpg)|*.jpg|Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
mvarDialogTitle = "Open File"
End Select
End Property
Private Function ErrTitle(ByVal pvSub, ByVal pvErr)
ErrTitle = mkCLASSNAME & "::" & pvSub & "():" & pvErr
End Function