How to export Power Queries from One Workbook to Another with VBA

Question

I am trying to transfer power queries from one workbook to another with VBA. I know how to do this manually but it can be very tedious.

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

Answer 1

Try solving it using the Workbook. Query Object.

 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