Экспорт запросов мощности от одной книги к другой с помощью VBA

Question

Я ищу передачу запросов энергии из одной книги в другую с помощью VBA. Я знаю, как это сделать вручную, но это очень громоздко.

Доступ к источнику питания можно получить через объект Workbook.Connections. В настоящее время я пытаюсь передать запросы с помощью функции VBA или Sub.

Ручной процесс выглядит следующим образом

• для каждого запроса в книге 1
• открыть книгу 1 и перейти к расширенному редактор - скопировать в текстовый редактор
• открыть учебное пособие 2 создать запрос, и вставки текста в расширенный редактор
• обеспечивают исходные таблицы одинаковы - и запустить запрос для проверки

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