Экспорт в Excel выбором папки для сохранения

Function экспорт_шаблона()
On Error GoTo экспорт_шаблона_Err
 
    DoCmd.OutputTo acOutputTable, "Реестр_шаблон", "ExcelWorkbook(*.xlsx)", "Реестр.xlsx", True, "", , acExportQualityScreen
 
 
экспорт_шаблона_Exit:
    Exit Function
 
экспорт_шаблона_Err:
    MsgBox Error$
    Resume экспорт_шаблона_Exit
 
End Function

  Dim dlgOpenFile As Object ' FileDialog
  Set dlgOpenFile = Application.FileDialog(4)
  With dlgOpenFile
    .Filters.Clear
    .InitialFileName = CurrentProject.Path
    .AllowMultiSelect = False
    .Title = "Выберите папку"
    If (.Show = -1) And (.SelectedItems.Count > 0) Then
        MyPath$ = .SelectedItems(1)
    End If
  End With
  Set dlgOpenFile = Nothing

    Dim wb As Workbook
    Set wb = Workbooks.Open(CurrentProject.path & "\Книга1.xls")
    wb.Application.Visible = True
    Set rng = Range("A1:B5")
    With rng
        .Interior.ColorIndex = 41 ' заливка цветом
        .Font.Bold = True ' шрифт жирный
        .Font.ColorIndex = 2 ' шрифт цвет
        .Font.Size = Range("A1").Font.Size + 1 ' увеличить шрифт на 1 ед. как в ячейке A1
    End With
    wb.Close False ' закрыть книгу не сохраняя