Создание сводок в файлах xlsx в Access VBA

Question

В «c:» есть несколько файлов xlsx, экспортированных из таблицы Microsoft Access.Имеется около 4 файлов с одинаковым количеством и именами столбцов, но с разными данными.

Когда код запускается, он корректно выполняет первый поворот xlsx без проблем, но вторая итерация приводит к ошибкам:

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    fileName, Version:=6).CreatePivotTable TableDestination:= _
    "Sheet1!R3C1", TableName:="PivotTable1", DefaultVersion:=6

Ошибка: ошибка времени выполнения '91': переменная объекта или переменная блока не установлена ​​

Я уже пытался использовать "myWorkbook" до Sheets, ActiveWorkbook и т. Д., Но это не сработало или я сделал это неправильно.

Все файлы Excel должны иметь сводные таблицы.

Sub test()
    Dim strF As String, strP As String
    Dim wb As Workbook
    Dim ws As Worksheet


    'Edit this declaration to your folder name
    strP = "c:\" 'change for the path of your folder


    strF = Dir(strP & "\*.xls*") 'Change as required



    Do While strF <> vbNullString
        'MsgBox strP & "\" & strF
        createPivot strP & "\" & strF, strF
        strF = Dir()
    Loop    
End Sub


Sub createPivot(path As String, fileName As String)

    fileName = Replace(fileName, ".xlsx", "")
    Dim appExcel As Excel.Application
    Dim myWorkbook As Excel.Workbook

    Set appExcel = CreateObject("Excel.Application")
    Set myWorkbook = appExcel.Workbooks.Open(path)
    appExcel.Visible = True

    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        fileName, Version:=6).CreatePivotTable TableDestination:= _
        "Sheet1!R3C1", TableName:="PivotTable1", DefaultVersion:=6
    Sheets("Sheet1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Field1")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Field2")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Field3")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("FieldN"), "Sum of FieldN", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Field+1")
        .Orientation = xlRowField
        .Position = 1
    End With

    myWorkbook.Save
    myWorkbook.Close

    appExcel.Quit

    Set myWorkbook = Nothing
    Set appExcel = Nothing
Exit Sub
End Sub

Answer 1

Исходный диапазон для вашей сводной кэш-памяти может быть неправильным. Для этого вы используете «имя файла» (это именованный диапазон, соответствующий имени файла, который действителен в каждой книге?).

Я предлагаю следующее:

• построить объект кода по объектам: рабочая книга, сводная кэш-память, рабочая таблица, сводная таблица, сводные поля, ...
• так как вы используете два приложения: объявите почти каждую переменную очень ясно, как Excel.Workbook
• избегать выбора или активации чего-либо

---

Sub test()
    Dim strF As String, strP As String
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet

    'Edit this declaration to your folder name
    strP = "c:\users\..." 'change for the path of your folder

    strF = Dir(strP & "\*.xls*") 'Change as required

    Do While strF <> vbNullString
        'MsgBox strP & "\" & strF
        createPivot strP & "\" & strF, strF
        strF = Dir()
    Loop
End Sub


Sub createPivot(path As String, fileName As String)
    Dim appExcel As Excel.Application
    Dim myWorkbook As Excel.Workbook
    Dim myWorksheet As Excel.Worksheet
    Dim pc As Excel.PivotCache
    Dim pt As Excel.PivotTable

    fileName = Replace(fileName, ".xlsx", "")

    On Error Resume Next
    Set appExcel = GetObject(, "Excel.Application")
    On Error GoTo 0
    If appExcel Is Nothing Then Set appExcel = CreateObject("Excel.Application")
    appExcel.Visible = True

    Set myWorkbook = appExcel.Workbooks.Open(path)

    Set pc = myWorkbook.PivotCaches.Create( _
        SourceType:=xlDatabase, _
        SourceData:=myWorkbook.Sheets(1).UsedRange) ' this might be adapted

    Set myWorksheet = myWorkbook.Sheets.Add
    Set pt = pc.CreatePivotTable( _
        TableDestination:=myWorksheet.Range("A3"), _
        TableName:="PivotTable1")

    With pt.PivotFields("Field1")
        .Orientation = xlPageField
        .Position = 1
    End With

    With pt.PivotFields("Field2")
        .Orientation = xlPageField
        .Position = 1
    End With

    With pt.PivotFields("Field3")
        .Orientation = xlColumnField
    End With

    With pt.PivotFields("FieldN")
        .Orientation = xlDataField
        .Function = xlSum
        .Name = "Sum of FieldN"
    End With

    With pt.PivotFields("Field+1")
        .Orientation = xlRowField
        .Position = 1
    End With

    myWorkbook.Save
    myWorkbook.Close
    Set myWorkbook = Nothing

    appExcel.Quit
    Set appExcel = Nothing
End Sub

Answer 2

Вы можете управлять Excel из Access, используя «Раннее связывание» или «Позднее связывание».

' EARLY BINDING
Option Compare Database
Option Explicit ' Use this to make sure your variables are defined

' One way to be able to use these objects throughout the Module is to Declare them
' Here and not in a Sub

Private objExcel As Excel.Application
Private xlWB As Excel.Workbook
Private xlWS As Excel.Worksheet

Sub Rep()

Dim strFile As String

strFile = "C:\Users\Excel\Desktop\YourExcelFile.xls"

' Opens Excel and makes it Visible
Set objExcel = New Excel.Application
objExcel.Visible = True

'Opens up the Workbook
Set xlWB = objExcel.Workbooks.Open(strFile)

'Sets the Workseet to the last active sheet - Better to use the commented version and use the name of the sheet.
Set xlWS = xlWB.ActiveSheet
'Set xlWS = xlWB("Sheet2")

With xlWS ' You are now working with the Named file and the named worksheet


End With

'Do Close and Cleanup
End Sub


 
' LATE BINDING
Sub ControlExcelFromAccess()

' No reference to a type library is needed to use late binding.
' As long as the object supports IDispatch, the method can
' be dynamically located and invoked at run-time.

' Declare the object as a late-bound object
  Dim oExcel As Object
  Dim strFile As String

  strFile = "C:\Users\Excel\Desktop\YourExcelFile.xls"

  Set oExcel = CreateObject("Excel.Application")

' The Visible property is called via IDispatch
  oExcel.Visible = True

  Set xlWB = oExcel.Workbooks.Open(strFile)

'Call code here . . .

Set oExcel = Nothing

End Sub