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

Question

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

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

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

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

Answer 1

Я смог решить эту проблему с помощью объекта Workbook.Query.

вот мое решение.

            Public Sub FunctionToTest_ForStackru()
                ' 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://stackru.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