使用 VBA 将 Power Queries 从一个工作簿导出到另一个工作簿

Question

我希望使用 VBA 将电源查询从一个工作簿转移到另一个工作簿。我知道如何手动执行此操作，但非常麻烦。

可以通过 Workbook.Connections 对象访问电源查询。我目前正在尝试使用 VBA 函数或 Sub.

移植查询

手动流程如下

对于工作簿 1 中的每个查询
打开工作簿 1 并转到高级编辑器 - 复制到文本编辑器
打开工作簿 2 创建查询，并将文本粘贴到高级编辑器中
确保源表相同 - 并且运行查询以验证

Answer 1

我能够使用 Workbook.Query 对象解决它。

这是我的解决方案。

            Public Sub FunctionToTest_ForWhosebug()
                ' Doug.Long
                Dim wb As Workbook

                ' create empty workbook
                Set NewBook = Workbooks.Add
                Set wb = NewBook

                ' copy queries
                CopyPowerQueries ThisWorkbook, wb, True

            End Sub

            Public Sub CopyPowerQueries(wb1 As Workbook, wb2 As Workbook, Optional ByVal copySourceData As Boolean)
                ' Doug.Long
                ' copy power queries into new workbook
                Dim qry As WorkbookQuery
                For Each qry In wb1.Queries
                    ' copy source data
                    If copySourceData Then
                        CopySourceDataFromPowerQuery wb1, wb2, qry
                    End If

                    ' add query to workbook
                    wb2.Queries.Add qry.Name, qry.formula, qry.Description
                Next
            End Sub

            Public Sub CopySourceDataFromPowerQuery(wb1 As Workbook, wb2 As Workbook, qry As WorkbookQuery)
                ' Doug.Long
                ' copy source data by pulling data out from workbook into other
                Dim qryStr As String
                Dim sourceStrCount As Integer
                Dim i As Integer
                Dim tbl As ListObject
                Dim sht As Worksheet

                sourceStrCount = (Len(qry.formula) - Len(Replace$(qry.formula, "Source = Excel.CurrentWorkbook()", ""))) / Len("Source = Excel.CurrentWorkbook()")

                For i = 1 To sourceStrCount
                    qryStr = Split(Split(qry.formula, "Source = Excel.CurrentWorkbook(){[Name=""")(1), """]}")(0)
                    For Each sht In wb1.Worksheets
                        For Each tbl In sht.ListObjects
                            If tbl.Name = qryStr Then
                                If Not sheetExists(sht.Name) Then
                                    sht.Copy After:=wb2.Sheets(wb2.Sheets.Count)
                                End If
                            End If
                        Next tbl
                    Next sht
                Next i

                qryStr = qry.formula


            End Sub


            Function sheetExists(sheetToFind As String) As Boolean
                '
                sheetExists = False
                For Each sheet In Worksheets
                    If sheetToFind = sheet.Name Then
                        sheetExists = True
                        Exit Function
                    End If
                Next sheet
            End Function

使用 VBA 将 Power Queries 从一个工作簿导出到另一个工作簿

Export Power Queries from One Workbook to Another with VBA

excel

vba

powerquery