Getting filenames in other applications than Excel
2011-07-02 Files & Folders 0 380
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