VBAを使用して1つのブックから別のブックに電力クエリをエクスポート

Question

VBAを使用してあるブックから別のブックにパワークエリを転送することを検討しています。私は手動でこれを行う方法を知っていますが、それは非常に面倒です。

Powerクエリには、Workbook.Connectionsオブジェクトからアクセスできます。 現在、VBA関数またはSubを使用してクエリを移植しようとしています。

は、クエリを作成開くワークブック2テキストエディタにコピーし、 - 1

はワークブック1を開き、高度なエディタに行くワークブック内の各クエリの

• を次のように

  手動のプロセスがありますそして、高度なエディタ

• に貼り付けるテキストは、ソース表が同じであることを確認 - と私がいた

Answer 1

を検証するためのクエリを実行しますWorkbook.Queryオブジェクトを使用して解決することができます。

ここに私の解決策です。

  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