将Excel Workbook从Access VBA保存

Question

我将记录集从访问查询中导出到Excel工作簿。导出良好，我的语法会尽我所能提示用户获取文件名/位置。但是，该文件实际上并未保存。我是否错过了该过程中的一步，或者需要进行哪些代码更改才能具有此功能？

    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

您的filedialog代码无法正常工作，因此，您没有得到有效的文件名和位置。

如果要返回选择的文件名，则应使用.SelectedItems(1)，而不是.InitialFileName。.InitialFileName设置了初始值，并且不会返回完整的路径。

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

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