Question

我想请求您获取Access VBA代码的帮助，该代码会将来自Access数据库（当前打开的数据库）的1个指定查询表中的所有数据导入MS Excel（该文件，即可由用户选择）。

我目前正在使用这段代码，但我收到的错误消息是：

＆＃34;运行时错误＆＃39; -2147023170（800706be）＆＃39;：

自动化错误远程过程调用失败。＆＃34;

你们中的任何人都知道如何修复连接吗？

Option Explicit
Option Compare Database

    Public Sub CopyRstToExcel_test()
    'On Error GoTo CopyRstToExcel_Err

        Dim sPath As String
        Dim fd As FileDialog
        Dim oExcel As Object
        Dim oExcelWrkBk As Object
        Dim oExcelWrSht As Object

        Dim dbs 'Added
        Dim qdfName As String
        Dim fRecords As Boolean

        Dim rst As dao.Recordset

        Dim iCols As Integer

        '-------------------------------------------------------------------------------------------------------------------------------------------------------------------
        ' Select the file and identify the path leading to the file
        '-------------------------------------------------------------------------------------------------------------------------------------------------------------------

        'Define database you want to work with
        Set dbs = CurrentDb

        'Select the Excel file you want to work with
        Set fd = Application.FileDialog(msoFileDialogFilePicker)

        'Define the path
        If fd.Show = -1 Then
            sPath = fd.SelectedItems(1)
        End If

        MsgBox sPath

        '-------------------------------------------------------------------------------------------------------------------------------------------------------------------
        ' Defining names of variables
        '-------------------------------------------------------------------------------------------------------------------------------------------------------------------

        'Defining variables (queries/tables)
        qdfName = "Query_1"

        '------------------------------------------------------------------------------------------------
        'Copying the data from Access into the new Excel
        '------------------------------------------------------------------------------------------------

        Set rst = CurrentDb.OpenRecordset(qdfName, dbOpenSnapshot)

        fRecords = False
        If rst.EOF = False Then
            fRecords = True

            Set oExcel = CreateObject("Excel.Application")
            Set oExcelWrkBk = GetObject(sPath)

            oExcel.Visible = True
            oExcel.ScreenUpdating = False

            Set oExcelWrSht = oExcelWrkBk.Sheets(1)

            For iCols = 0 To rst.Fields.Count - 1
                oExcelWrSht.Cells(9, iCols + 2).Value = rst.Fields(iCols).Name
            Next

            oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _
                oExcelWrSht.Cells(9, rst.Fields.Count)).Font.Bold = True

            oExcelWrSht.Range("B10").CopyFromRecordset rst

            oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _
                oExcelWrSht.Cells(rst.RecordCount + 9, rst.Fields.Count)).Columns.AutoFit

            oExcelWrSht.Range("A1").Select

        End If


    '------------------------------------------------------------------------------------------------
    CopyRstToExcel_Done:
        On Error Resume Next
        If fRecords = True Then
            oExcel.Visible = True
            oExcel.ScreenUpdating = True
        End If
        Set oExcelWrSht = Nothing
        Set oExcelWrkBk = Nothing
        Set oExcel = Nothing
        Set rst = Nothing

    ''Error message:
    'CopyRstToExcel_Err:
    '    MsgBox Err & ": " & Error, vbExclamation
    '    Resume CopyRstToExcel_Done
    '    Resume
    '------------------------------------------------------------------------------------------------

    End Sub

在这一步中，我只想复制第一张表中的数据，但稍后我还要指定表单的名称，并且我已准备好模板我要复制数据

感谢您的帮助！

Answer 1

尝试替换

Set oExcelWrkBk = GetObject(sPath)

通过

Set oExcelWrkBk = oExcel.Workbooks.Open(sPath)

另外我建议更换

Set rst = CurrentDb.OpenRecordset(qdfName, dbOpenSnapshot)

通过

Set rst = dbs.OpenRecordset(qdfName, dbOpenSnapshot)

打开指定的工作表：

Set oExcelWrSht = oExcelWrkBk.Sheets("MyWorksheetName")

使用Access VBA从Access导入数据到Excel

1 个答案: