从 Access VBA 保存 Excel 工作簿

Question

我正在将访问查询中的记录集导出到 Excel 工作簿。导出正常，我的语法提示用户输入 filename/location，正如我需要的那样。但是，该文件并未实际保存。我是否遗漏了流程中的某个步骤或需要更改哪些代码才能拥有此功能？

    Sub ETE()

    Dim ExcelApp As Object, wbOutput As Object, wsOutput As Object, bExcelOpened As Boolean
    Dim db As DAO.Database, rs As DAO.Recordset, targetRow As Long
    Dim targetPath As String, fd As FileDialog, Title As String, saveInfo As Variant

    DoCmd.Hourglass True

    Set ExcelApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo Error_Handler
        Set ExcelApp = CreateObject("Excel.Application")
        bExcelOpened = False
    Else
        bExcelOpened = True
    End If
    On Error GoTo Error_Handler
    ExcelApp.ScreenUpdating = False
    ExcelApp.Visible = False
    Set wbOutput = ExcelApp.Workbooks.Add()
    Set wsOutput = wbOutput.Sheets(1)
    Set db = CurrentDb
    Set rs = db.OpenRecordset("qryTakeDataToExcel", dbOpenSnapshot)

    With rs
        If .RecordCount <> 0 Then
            'Write the data to Excel
        End If
    End With
    Set fd = Application.FileDialog(msoFileDialogSaveAs)

    With fd
        .AllowMultiSelect = False
        .Title = "Select Save Location And File Name"
        .InitialFileName = "File_" & Format(Now(), "mmddyyyy") & ".xlsx"

        If .Show = True Then
            wbOutput.SaveAs FileName:=fd.InitialFileName, FileFormat:=50
            wbOutput.Close
        End If
    End With

End Sub

Answer 1

您的文件对话框代码没有按预期工作，因此，您没有获得有效的文件名和位置。

如果你想return选择的文件名，你应该使用.SelectedItems(1)，而不是.InitialFileName。 .InitialFileName 设置初始值而不是 return 完整路径。

    If .Show = True Then
        wbOutput.SaveAs FileName:=.SelectedItems(1), FileFormat:=50
        wbOutput.Close
    End If

如果您使用了有效的错误处理程序，这可能更容易发现。使用 On Error GoTo 0 以使用默认错误处理程序。

从 Access VBA 保存 Excel 工作簿

Save Excel Workbook From Access VBA

ms-access

vba

excel-2013

ms-access-2013