将电力查询从一个工作簿导出到另一个VBA [英] Export Power Queries from One Workbook to Another with VBA

问题描述

我正在寻找通过VBA将功能查询从一个工作簿转移到另一个工作簿。我知道如何手动这样做，但这是非常麻烦的。

可以通过Workbook.Connections对象访问电源查询。
我正在尝试使用VBA函数或子代码移交查询。

手动过程如下

• 对于工作簿1中的每个查询


• 打开工作簿1并转到高级编辑器 - 复制到文本编辑器


• 打开工作簿2创建查询，并将文本粘贴到高级编辑器中


• 确保源表相同 - 并运行查询以验证

解决方案

我可以通过使用Workbook.Query对象来解决它。

这是我的解决方案。

  Public Sub FunctionToTest_ForStackOverflow（）
'Doug.Long 
设置wb = NewBook 
 
'复制查询
 CopyPowerQueries ThisWorkbook，wb，Tr ue 
 
 End Sub 
 
 Public Sub CopyPowerQueries（wb1 As Workbook，wb2 As Workbook，Optional ByVal copySourceData As Boolean）
'Doug.Long 
'将功能查询复制到新工作簿
 Dim qry As WorkbookQuery 
对于每个qry在wb1.Queries 
'复制源数据
如果copySourceData然后
 CopySourceDataFromPowerQuery wb1，wb2，qry 
 End If 
 
'将查询添加到工作簿
 wb2.Queries.Add qry.Name，qry.formula，qry.Description 
下一个
 End Sub 
 
 Public Sub CopySourceDataFromPowerQuery（wb1 As Workbook，wb2 As Workbook，qry As WorkbookQuery）
'Doug.Long 
'将数据从工作簿中拉出到其他
 Dim qryStr As String 
 Dim sourceStrCount As Integer 
 Dim i As Integer 
 Dim tbl As ListObject 
 Dim sht As Worksheet 
 
 sourceStrCount =（Len（qry （.gif）（）$（$ q $。$）$（$） i = 1 To sourceStrCount 
 qryStr = Split（Split（qry.formula，Source = Excel.CurrentWorkbook（）{[Name =）（1），]}）（0）
对于每个sht在wb1.Worksheets 
对于每个tbl在sht.ListObjects 
如果tbl.Name = qryStr然后
如果不是sheetExists（sht.Name）然后
 sht .Copy After：= wb2.Sheets（wb2.Sheets.Count）
 End If 
 End If 
 Next tbl 
下一个sht 
下一个i 
 
 qryStr = qry.formula 
 
 
 End Sub 
 
 
函数sheetExists（sheetToFind As String）As Boolean 
'http://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-exists 
 sheetExists = False 
对于每个工作表In工作表
如果sheetToFind = sheet.Name然后
 sheetExists = True 
退出函数
结束如果
下一张单据
结束函数
  

I am looking to transfer power queries from one workbook to another with VBA. I know how to do this manually but it is very cumbersome.

A power query can be accessed via the Workbook.Connections object. I am currently attempting to port the queries over with a VBA function or Sub.

The manual process is as follows

• for each query in workbook 1
• open up workbook 1 and go to advanced editor - copy into a text editor
• open up workbook 2 create query, and paste text into advanced editor
• ensure source tables are the same - and run query to validate

解决方案

I was able to solve it by using the Workbook.Query object.

here is my solution.

            Public Sub FunctionToTest_ForStackOverflow()
                ' 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
                'http://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-exists
                sheetExists = False
                For Each sheet In Worksheets
                    If sheetToFind = sheet.Name Then
                        sheetExists = True
                        Exit Function
                    End If
                Next sheet
            End Function

这篇关于将电力查询从一个工作簿导出到另一个VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！