Getting filenames in other applications than Excel
2011-07-02 Files & Folders 0 426
In Excel we find the really nice functionality Application.GetOpenFilename and Application.GetSaveAsFilename that makes it really easy to ask the user for one or more filenames when opening or saving files. In other Office-applications this is sometimes not equally easy to achieve. The good news is that you can borrow this nice functionality from Excel in the other applications. Below you will find two functions that can be used outside Excel that will replicate this functionality for retrieving filenames. The functions use basically the same arguments as the Excel functions. Look them up in the built in VBA Help to get details about how to use e.g. the strFileFilter argument.
Function GetOpenFilename(strFileFilter As String, Optional strCaption As String = vbNullString, _
Optional blnMulti As Boolean = False, Optional strInitialFolder As String = vbNullString) As Variant
Dim objXL As Object
GetOpenFilename = False
If Len(strInitialFolder) >= 3 Then
On Error Resume Next
ChDrive Left(strInitialFolder, 1)
ChDir strInitialFolder
On Error GoTo 0
End If
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
On Error GoTo 0
If Not objXL Is Nothing Then
With objXL
GetOpenFilename = .GetOpenFilename(strFileFilter, 1, strCaption, , blnMulti)
.Quit
End With
Set objXL = Nothing
End If
End Function
Function GetSaveAsFilename(strInitialFileName As String, strFileFilter As String, _
Optional strCaption As String = vbNullString, Optional strInitialFolder As String = vbNullString) As Variant
Dim objXL As Object
GetSaveAsFilename = False
If Len(strInitialFolder) >= 3 Then
On Error Resume Next
ChDrive Left(strInitialFolder, 1)
ChDir strInitialFolder
On Error GoTo 0
End If
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
On Error GoTo 0
If Not objXL Is Nothing Then
With objXL
GetSaveAsFilename = .GetSaveAsFilename(strInitialFileName, strFileFilter, 1, strCaption)
.Quit
End With
Set objXL = Nothing
End If
End Function
Sub UsageExamples()
Dim varItems As Variant, i As Long
' how to retrieve a single filename for opening:
varItems = GetOpenFilename("Excel Files (*.xl*),*.xl*,All Files (*.*),*.*", "Select Multiple Files", True)
If len(varItems) >= 6 Then ' one file selected
Debug.Print varItems
End If
' how to retrieve multiple filenames for opening:
varItems = GetOpenFilename("Excel Files (*.xl*),*.xl*,All Files (*.*),*.*", "Select Multiple Files", True)
If IsArray(varItems) Then ' one or more files selected
For i = LBound(varItems) To UBound(varItems)
Debug.Print i, varItems(i)
Next i
End If
' how to retrieve a single filename for saving:
varItems = GetSaveAsFilename("InitialWorkbook.xlsx", "Excel Files (*.xlsx),*.xlsx,All Files (*.*),*.*")
If Len(varItems) >= 6 Then ' one filename returned
Debug.Print varItems
End If
End Sub