使用DAO Recordset创建Excel数据透视表 [英] Creating Excel PivotTable using DAO Recordset

问题描述

嗨 -

我有一些代码可以从MS Access中的DAO记录集创建一个Excel数据透视表（粘贴在下面）。  代码在粗体行上重复失败，错误代码为1004：应用程序定义或对象定义错误。  我已经看到很多使用PivotCache对象的Recordset属性的
代码示例......但它们都使用了ADO记录集。  开始怀疑我是否必须使用ADO而不是DAO。  任何建议/帮助表示赞赏！

    'On Error GoTo ErrorHandler



    Dim DivisionQuery As DAO.QueryDef

    Dim Divisions As DAO.Recordset

    Dim DivisionDataQuery As DAO.QueryDef

    Dim DivisionData As DAO.Recordset

    Dim CurrentField As DAO.Field

    Dim MSExcel As New Excel.Application

    Dim ExcelPivotCache As Excel.PivotCache

    Dim SQLText As String



    '初始化变量

    SQLText =" SELECT DISTINCT Divisions.Division" _

        &安培; "FROM Divisions;"&b
$
    '初始化对象

    Set DivisionQuery = CurrentDb.CreateQueryDef（""，SQLText）

    Set Divisions = DivisionQuery.OpenRecordset



    '构建部门工作簿

   有分部

       如果（不是.BOF）和（不是.EOF）则为
            .MoveFirst



            Do Until Divisions.EOF

                '初始化变量

                SQLText =" SELECT [原始数据]。*" _

                    &安培; "FROM [原始数据]" _

                    &安培; "WHERE（[原始数据] .Division ="& Chr（34）& Divisions.Fields（" Division"）& Chr（34）&"）;"



                '初始化对象

               设置DivisionDataQuery = CurrentDb.CreateQueryDef（""，SQLText）

               设置DivisionData = DivisionDataQuery.OpenRecordset



               使用DivisionData

                   如果（不是.BOF）和（不是.EOF）则为
                       使用MSExcel

                            .Visible = True

                            .Workbooks.Add

                            .ActiveWorkbook.Worksheets（" Sheet1"）。选择



                            '粘贴数据&写字段名称

                            .ActiveSheet.Range（" A2"）。CopyFromRecordset DivisionData

                           对于每个CurrentField在DivisionData.Fields中，
                                .ActiveCell.Value = CurrentField.Name

                                .ActiveCell.Offset（0,1）。选择

                           下一个CurrentField



                           使用.ActiveWorkbook

                                '创建数据透视表

                                .Sheets.Add

                                .Worksheets（" Sheet2"）。选择

                               设置ExcelPivotCache = .PivotCaches.Add（xlExternal）

                               设置ExcelPivotCache.Recordset = DivisionData



                                ExcelPivotCache.CreatePivotTable TableDestination：=。ActiveSheet.Range（" A3"），TableName：=" Division Pivot"，ReadData：= True，DefaultVersion：= xlPivotTableVersion15



                               使用.ActiveSheet.PivotTables（"Division Pivot"）。PivotFields（"客户名称"）

                                    .Orientation = xlRowField

                                    .Position = 1

                               结束与$


                               使用.ActiveSheet.PivotTables（"Division Pivot"）。PivotFields（"Pyramid Segment"）

                                    .Orientation = xlColumnField

                                    .Position = 1

                               结束与$


                               使用.ActiveSheet.PivotTables（"Division Pivot"）

                                    .AddDataField ActiveSheet.PivotTables（" Division Pivot"）。PivotFields（"Net Sales"），"Total Net Sales"，
xlSum

                               结束与$


                                '保存&关闭Excel文件

                                .SaveAs" C：\ Users \ [HIDDEN] \Desktop \" &安培; Divisions.Fields（"Division"）& " .xlsx"

                                。关闭

                           结束与$
                       结束与$
                   结束如果

               结束与$


                .MoveNext



                '关闭对象

                DivisionDataQuery.Close

                DivisionData.Close

           循环

       结束如果

   结束与$


    '关闭&发布对象

    DivisionQuery.Close

   分部。关闭



    Set DivisionQuery = Nothing

    Set Divisions = Nothing

    Set DivisionDataQuery = Nothing

    Set DivisionData = Nothing

   设置MSExcel = Nothing



   退出Sub¥


ErrorHandler：

    Dim ErrorMessage As String



   选择Case Err.Number

        Case Else

            ErrorMessage = Err.Number& "：" &安培;错误描述

   结束选择

    MsgBox ErrorMessage，vbCritical + vbOKOnly，"Build Workbooks"&

解决方案

< blockquote>

这里使用的文本编辑器很烦人。有时粗体/斜体有效但通常不起作用。

用箭头表示该行--->代替

Hi -

I've got some code to create an Excel PivotTable from a DAO recordset in MS Access (pasted below).  The code repeatedly fails on the line in bold with error code 1004: Application defined or object defined error.  I've seen lots of examples of code using the Recordset property of the PivotCache object...but they all used ADO recordsets.  Starting to wonder if maybe I have to use ADO instead of DAO.  Any advice/help is appreciated!

    'On Error GoTo ErrorHandler

    Dim DivisionQuery As DAO.QueryDef
    Dim Divisions As DAO.Recordset
    Dim DivisionDataQuery As DAO.QueryDef
    Dim DivisionData As DAO.Recordset
    Dim CurrentField As DAO.Field
    Dim MSExcel As New Excel.Application
    Dim ExcelPivotCache As Excel.PivotCache
    Dim SQLText As String

    ' Initialize Variables
    SQLText = "SELECT DISTINCT Divisions.Division " _
        & "FROM Divisions;"

    ' Initialize Objects
    Set DivisionQuery = CurrentDb.CreateQueryDef("", SQLText)
    Set Divisions = DivisionQuery.OpenRecordset

    ' Build Division Workbooks
    With Divisions
        If (Not .BOF) And (Not .EOF) Then
            .MoveFirst

            Do Until Divisions.EOF
                ' Initialize Variables
                SQLText = "SELECT [Raw Data].* " _
                    & "FROM [Raw Data] " _
                    & "WHERE ([Raw Data].Division = " & Chr(34) & Divisions.Fields("Division") & Chr(34) & ");"

                ' Initialize Objects
                Set DivisionDataQuery = CurrentDb.CreateQueryDef("", SQLText)
                Set DivisionData = DivisionDataQuery.OpenRecordset

                With DivisionData
                    If (Not .BOF) And (Not .EOF) Then
                        With MSExcel
                            .Visible = True
                            .Workbooks.Add
                            .ActiveWorkbook.Worksheets("Sheet1").Select

                            ' Paste Data & Write Field Names
                            .ActiveSheet.Range("A2").CopyFromRecordset DivisionData
                            For Each CurrentField In DivisionData.Fields
                                .ActiveCell.Value = CurrentField.Name
                                .ActiveCell.Offset(0, 1).Select
                            Next CurrentField

                            With .ActiveWorkbook
                                ' Create Pivot Table
                                .Sheets.Add
                                .Worksheets("Sheet2").Select
                                Set ExcelPivotCache = .PivotCaches.Add(xlExternal)
                                Set ExcelPivotCache.Recordset = DivisionData

                                ExcelPivotCache.CreatePivotTable TableDestination:=.ActiveSheet.Range("A3"), TableName:="Division Pivot", ReadData:=True, DefaultVersion:=xlPivotTableVersion15

                                With .ActiveSheet.PivotTables("Division Pivot").PivotFields("Customer Name")
                                    .Orientation = xlRowField
                                    .Position = 1
                                End With

                                With .ActiveSheet.PivotTables("Division Pivot").PivotFields("Pyramid Segment")
                                    .Orientation = xlColumnField
                                    .Position = 1
                                End With

                                With .ActiveSheet.PivotTables("Division Pivot")
                                    .AddDataField ActiveSheet.PivotTables("Division Pivot").PivotFields("Net Sales"), "Total Net Sales", xlSum
                                End With

                                ' Save & Close Excel File
                                .SaveAs "C:\Users\[HIDDEN]\Desktop\" & Divisions.Fields("Division") & ".xlsx"
                                .Close
                            End With
                        End With
                    End If
                End With

                .MoveNext

                ' Close Objects
                DivisionDataQuery.Close
                DivisionData.Close
            Loop
        End If
    End With

    ' Close & Release Objects
    DivisionQuery.Close
    Divisions.Close

    Set DivisionQuery = Nothing
    Set Divisions = Nothing
    Set DivisionDataQuery = Nothing
    Set DivisionData = Nothing
    Set MSExcel = Nothing

    Exit Sub

ErrorHandler:
    Dim ErrorMessage As String

    Select Case Err.Number
        Case Else
            ErrorMessage = Err.Number & ": " & Err.Description
    End Select
    MsgBox ErrorMessage, vbCritical + vbOKOnly, "Build Workbooks"

解决方案

Text editor used here is buggish. Sometimes bold/italic works but most often not.

Indicate the line with an arrow ---> instead

这篇关于使用DAO Recordset创建Excel数据透视表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！