excel - Export Power Queries from One Workbook to Another with VBA

Question

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

Answer 1

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