MS Access表作为excel文件导出到用户定义的文件夹

时间:2018-05-02 15:51:45

标签: vba ms-access

下面的代码工作正常,并将访问表数据导出到excel文件(C:\ temp \ test.xlsx)。

但我的要求是不要在VBA脚本中定义C:\ temp文件夹,系统应该要求用户选择输出目录。你能帮我准备一下VBA脚本吗?

Private Sub Command3_Click()

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

1 个答案:

答案 0 :(得分:2)

正如@Shanayl指出的那样,您可以提示用户在其本地计算机上选择一个文件夹,然后将结果传递给DoCmd.TransferSpreadsheet,因为它接受字符串值。不要简单地将 fd 连接到文件路径中。

下面修改@eabraham's answer以在VBA函数中为用户运行文件夹选择器对话框而不是文件选择器,而不是稍后为Excel文件调用的VBA子。

功能 (将表单/报告放在与按钮点击事件相同的区域)

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

对于数据库中的每个表,使用MS Access的TableDefs方法的 range 参数循环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 is not a database。必须将整个MS Access数据库转储到Excel工作簿中,甚至整个表都可能需要重新考虑。也许您的用户需要定制和过滤的表或查询(即QueryDefs)。最佳做法是使用Excel作为最终用途报告应用程序,使用Access作为中央存储库后端。