Автоматизированный экспорт доступа к табличным данным для заполнения шаблона Excel Sheet

Question

Я работаю над экспортом отфильтрованных данных таблицы из Access на лист Excel, но я могу только получить данные таблицы для экспорта в новые файлы Excel, а не в файлы шаблонов Excel (с готовыми графиками для заполнения).

Я в основном использовал макросы в Access для создания коммутатора, где пользователь нажимает кнопку коммутатора, и отфильтрованные данные экспортируются из таблицы в Access в новый файл Excel в папке «Отчеты». Я не знаю, что макросы можно экспортировать с помощью шаблонов файлов Excel, поэтому я перешел к изучению VBA. Я новичок в VBA, поэтому я прошу прощения за мое тривиальное понимание. Я создал некоторый код VBA, основанный на учебнике из Access Jujitsu на Youtube.

Private Sub Command0_Click()
On Error GoTo SubError

    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim SQL As String
    Dim rs1 As DAO.Recordset
    Dim i As Integer
    Dim qtr As String

    'Show user work is being performed
    DoCmd.Hourglass (True)

    '*********************************************
    '              RETRIEVE DATA
    '*********************************************
    'SQL statement to retrieve data from database
    SQL = "SELECT Obj, Owner, Recom, Goal, Quality of Measure" & _
    "FROM Inventory " & _
    "WHERE Owner = ASM" &
    "ORDER BY Recom "

    'Execute query and populate recordset
    Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

    'If no data, don't bother opening Excel, just quit
    If rs1.RecordCount = 0 Then
        MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
        GoTo SubExit
    End If

    '*********************************************
    '             BUILD SPREADSHEET
    '*********************************************
    'Create an instance of Excel and start building a spreadsheet
    'Early Binding
    Set xlApp = Excel.Application

    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Open("\Users\Desktop to TemplateACC.xlsx")
    Set xlSheet = xlBook.Worksheets(1)

    With xlSheet

        'Set second page title - pull quarter and year off of first row
        'Won't work if you are pulling multiple time periods!
        Select Case Nz(rs1!SalesQuarter, "")
            Case 1
                qtr = "1st"
            Case 2
                qtr = "2nd"
            Case 3
                qtr = "3rd"
            Case 4
                qtr = "4th"
            Case Else
                qtr = "???"
        End Select
        .Range("B3").Value = qtr & " Quarter " & Nz(rs1!SalesYear, "????")

        'provide initial value to row counter
        i = 1
        'Loop through recordset and copy data from recordset to sheet
        Do While Not rs1.EOF

            .Range("I" & i).Value = Nz(rs1!Owner, "")
            .Range("J" & i).Value = Nz(rs1!Goal, 0)
            .Range("K" & i).Value = Nz(rs1!Recom, 0)

            i = i + 1
            rs1.MoveNext

        Loop

    End With


SubExit:
On Error Resume Next

    DoCmd.Hourglass False
    xlApp.Visible = True
    rs1.Close
    Set rs1 = Nothing

    Exit Sub



SubError:
    MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
        "An error occurred"
    GoTo SubExit

End Sub

Private Sub Form_Load()

End Sub

Мой код не будет работать, так как он говорит, что «Определяемый пользователем тип не определен» при ошибке. Я создал этот код из кнопки в новой форме, открыв шаблон кодирования VBA, создав событие из кнопки. Я не уверен, почему код не будет работать. Предполагается экспортировать в существующий ранее файл с именем «TemplateACC», но вместо этого появляется эта ошибка. Спасибо, что остаетесь со мной на этом!

Answer 1

Вы добавили библиотеку объектов Excel?

В редакторе VBA перейдите в Инструменты -> Ссылки, найдите библиотеку объектов Microsoft Excel 1X.0 и проверьте ее.

X зависит отверсия Excel установлена, но должна быть только одна, вероятно от 14 до 16.

Answer 2

Привязка может быть вашей проблемой. Вы можете реализовать раннее связывание, добавив библиотеку объектов MS Excel к своим ссылкам (Инструменты -> Ссылки), или вы можете реализовать позднее связывание, как показано ниже:

Private Sub Command0_Click()
Dim xlApp As object
Dim xlBook As object
Dim xlSheet As object

''If excel is already Running, grab that instance of the program, if not, create new
set xlApp = GetExcel
set xlBook = xlApp.Workbooks.Open("\Users\Desktop to TemplateACC.xlsx")
Set xlSheet = xlBook.Worksheets(1)

''... do other stuff

End sub

Function GetExcel() As Object 'Excel.Application

'Updated: 2009-10-13
'Used to grab the Excel application for automation

   If DetectExcel Then
       Set GetExcel = GetObject(, "Excel.Application")
   Else
       Set GetExcel = CreateObject("Excel.Application")
   End If

End Function

Function DetectExcel() As Boolean

' Procedure dectects a running Excel and registers it.
    Const WM_USER = 1024
    Dim hwnd As Long

''If Excel is running this API call returns its handle.
    hwnd = FindWindow("XLMAIN", 0)
    If hwnd = 0 Then ' 0 means Excel not running.
        DetectExcel = False
        Exit Function
    ''Excel is running so use the SendMessage API
    ''function to enter it in the Running Object Table.
        DetectExcel = True
        SendMessage hwnd, WM_USER + 18, 0, 0
    End If

End Function