Save As File Dialog in Access VBA

 Private Sub cmdBrowse_Click()
Const ssource As String = "cmdNext_Click"
Dim strOutputFolder As String
On Error GoTo ErrorHandler

'strOutputFolder = BrowseFolder("Output folder for client statements")
strOutputFolder = getFolderDestination(Nz(Me.txtOutputFolder))
If Len(strOutputFolder) Then
    Me.txtOutputFolder.Value = strOutputFolder
  
End If
ExitProc:
   On Error Resume Next
   Exit Sub
  
ErrorHandler:
    If bCentralErrorHandler(msMODULE, ssource, , bEntryPoint:=True) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If
End Sub

Function getFolderDestination(Optional strInitialFileName As String) As String

Const ssource As String = "getSaveAs2"
Dim fDialog As Office.FileDialog
On Error GoTo ErrorHandler
' Requires reference to Microsoft Office 11.0 Object Library.

' Set up the File Dialog.
'Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
   
    If Len(strInitialFileName) Then
        .InitialFileName = strInitialFileName
    End If
    ' Set the title of the dialog box.
    '.Title = "Please select one or more files"

   
      ' Show the dialog box. If the .Show method returns True, the
      ' user picked at least one file. If the .Show method returns
      ' False, the user clicked Cancel.
    If .Show Then
        getFolderDestination = .SelectedItems(1)
    End If
End With


ExitProc:
    On Error Resume Next
    Set fDialog = Nothing
    Exit Function

ErrorHandler:
   
    If bCentralErrorHandler(msMODULE, "getSaveAs2") Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If


End Function

Function getFileOpen2(iOfficeVersion As OfficeProduct, _
    Optional bAllowMultiSelect As Boolean = False, _
    Optional strInitialFileName As String, _
    Optional ByVal strTitle As String) As String
Const ssource As String = "getFileOpen2"
Dim fDialog As Office.FileDialog
On Error GoTo ErrorHandler
' Requires reference to Microsoft Office 11.0 Object Library.

' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
'Set fDialog = Application.FileDialog(msoFileDialogSaveAs)

With fDialog
    .AllowMultiSelect = bAllowMultiSelect
         
    'If Len(strInitialFileName) Then
     '   .InitialFileName = strInitialFileName
    'End If
    ' Set the title of the dialog box.
    If Len(strTitle) > 0 Then
        .Title = strTitle
    Else
        .Title = "Please select one or more files"
    End If
   
    ' Clear out the current filters, and add our own.
    .Filters.Clear
    Select Case iOfficeVersion
        Case OfficeProduct.Excel2007Only
            .Filters.Add "Excel 2007 Workbooks", "*.XLSX"
            .Filters.Add "All Files", "*.*"

        Case OfficeProduct.Access2007Only
            .Filters.Add "Access Databases", "*.MDB"
            .Filters.Add "Access Projects", "*.ADP"
            .Filters.Add "All Files", "*.*"
           
        Case OfficeProduct.XML
           ' .Filters.Add "All Files", "*.*"
            .Filters.Add "XML Files", "*.XML"
           
       
        Case Else
            .Filters.Add "All Files", "*.*"
    End Select
   
      ' Show the dialog box. If the .Show method returns True, the
      ' user picked at least one file. If the .Show method returns
      ' False, the user clicked Cancel.
    If .Show Then
        getFileOpen2 = .SelectedItems(1)
    End If
End With


ExitProc:
    On Error Resume Next
    Set fDialog = Nothing
    Exit Function

ErrorHandler:
   
    If bCentralErrorHandler(msMODULE, "getSaveAs2") Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If


End Function