Option Explicit
'*** Code to test the GetFileToOpen Function ***
Sub Main()
Dim zFileItems() As String
Dim zSelectedFiles As String
Dim zAllowedExts As String
Dim lNoFiles As Long
Dim lCnt As Long
Dim zFileText As String
Dim zFileLine As String
ReDim zFileItems(1)
zAllowedExts = "*.txt"
lNoFiles = GetFileToOpen(zFileItems, zAllowedExts, False, "*.txt*")
If lNoFiles > 0 Then
Open zFileItems(1) For Input As #1
Input #1, zFileText
Do While Not EOF(1)
Input #1, zFileLine
zFileText = zFileText + " " + zFileLine
Loop
Close #1
[A7] = zFileText
Else
MsgBox "User pressed Cancel or X (Close Box).", vbOKOnly, _
"No Files Selected:"
End If
End Sub 'Main()
' +--------------------+ +----------+
'------------------------| GetFileToOpen() |-----------------| 01/15/14 |
' +--------------------+ +----------+
'Called by :
'Arguments : zSelected - a String array declared empty & ReDimed to 1
' zExts - a list of allowed extensions for the filter
' Ex: "*.xlsx, *.xls, *.xlsm, *.xlsb"
' Note: Only Excel filetypes as function is written!
' zMulti - True allows multi select, False allows single select.
' zFileFilter - Optional - used to limit the files shown by name
' pattern, EX: "CA*.xls*" if ommited "*.xls*" will
' be used. Note: using "*.*" will over ride the zExts
' filter! You can also specify a drive/path to set
' the initial folder displayed.
'Notes : You can uncomment the .Title line and supply your own
' dialog box title and add an argument if you want to pass it!
' You can uncomment the .ButtonName to supply a custom OK button
' caption which can also be passed by argument if desired.
Function GetFileToOpen(ByRef zSelected, zExts As String, bMulti As Boolean, _
Optional zFileFilter As Variant) As Long
Dim fd As FileDialog
Dim lCnt As Long
If IsMissing(zFileFilter) Then zFileFilter = "*.xls*"
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear '*** Clear old filters just precautionary ***
.Filters.Add "Spreadsheets", zExts, 1
.InitialFileName = zFileFilter '*** File Name Filter control. ***
' .Title = "You're Dialog Box Title Here"
' .ButtonName = "OK button caption"
.AllowMultiSelect = bMulti 'Note: if not specified defaults to True!
'.Show Returns: -1 if Open button or 0 if Cancel button is pushed!
If .Show = -1 Then
ReDim zSelected(.SelectedItems.Count) 'Make array the proper size.
For lCnt = 1 To .SelectedItems.Count 'Load the array with selections.
zSelected(lCnt) = .SelectedItems.Item(lCnt)
Next lCnt
End If
GetFileToOpen = .SelectedItems.Count
End With 'fd
End Function 'GetFileToOpen