Экспорт таблицы MS Access в виде файла Excel в пользовательскую папку

Question

Ниже код работает нормально и экспортирует данные таблицы доступа в файл Excel (C: \ temp \ test.xlsx).

Но мое требование - вместо определения папки C: \ temp в скрипте VBA, система должна попросить пользователя выбрать выходной каталог. Не могли бы вы помочь мне подготовить этот сценарий VBA?

Private Sub Command3_Click()

 DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Fields", _
       "C:\temp\text.xlsx", True
End Sub

Answer 1

Как указывает @Shanayl, вы можете предложить пользователю выбрать папку на своих локальных машинах, а затем передать результат в DoCmd.TransferSpreadsheet, поскольку он принимает строковое значение. Не просто конкатенируйте fd в путь к файлу.

Ниже изменяется @ ответ eabraham , чтобы запустить диалоговое окно выбора папки, а не средство выбора файла для пользователя в функции VBA и не подпрограмму VBA, которая будет вызываться позже для файла Excel.

Функция (поместить за форму / отчет в той же области, что и событие нажатия кнопки)

Private Function GetExcelFolder() As String       
   Dim fldr As FileDialog
   Dim txtFileName As String

   ' FOLDER PICKER
   Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

   With fldr
      .AllowMultiSelect = False

      ' Set the title of the dialog box.
      .Title = "Please select folder for Excel output."

      ' 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 = True Then
        txtFileName = .SelectedItems(1)
      Else
        Msgbox "No File Picked!", vbExclamation
        txtFileName = ""
      End If
   End With

   ' RETURN FOLDER NAME
   GetExcelFolder = txtFileName       
End Function

Событие нажатия кнопки

Private Sub Command3_Click()
    Dim user_excel_fldr As String

    ' CALL FUNCTION
    user_excel_fldr = GetExcelFolder()    
    If user_excel_fldr = "" Then Exit Sub

    ' SPECIFY ONE TABLE
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "myTableName", _
       user_excel_fldr & "\" & "ExcelOutput.xlsx", True
End Sub

И для каждой таблицы в вашей базе данных выполните цикл TableDefs , используя range аргумент метода MS Access DoCmd.TransferSpreadsheet , чтобы вывести каждую на конкретную вкладку рабочего листа. .

Private Sub Command3_Click()
    Dim user_excel_fldr As String
    Dim tbldef As TableDef

    ' CALL FUNCTION
    user_excel_fldr = GetExcelFolder()
    If user_excel_fldr = "" Then Exit Sub

    ' LOOP THROUGH ALL TABLE NAMES
    For Each tbldef In CurrentDb.TableDefs    
        If Not tbldef.Name Like "*MSys*"    ' AVOID SYSTEM TABLES
           DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, tbldef.Name, _
               user_excel_fldr & "\" & "ExcelOutput.xlsx", True, tbldef.Name & "!"
        End If
    Next tbldef

    Set tbldef = Nothing
End Sub

Кстати, обратите внимание Excel не является базой данных . Необходимость выгрузки всей базы данных MS Access в книгу Excel, даже целые таблицы, может потребовать пересмотра. Может быть, вашим пользователям нужны специализированные и отфильтрованные таблицы или запросы (например, QueryDefs). Рекомендуется использовать Excel в качестве приложения для отчетов о конечном использовании, а Access - в качестве центрального серверного хранилища.