Export Power Queries from One Workbook to Another with VBA - 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