Запись макроса: получение данных из файла - PullRequest
Новая
       8

Запись макроса: получение данных из файла

0 голосов
/ 03 января 2019

Я начну с признания того, что макросы, как правило, не мое дело, и написание кода, конечно, не так - но в этой ситуации и прочитав о записи макросов, я подумал, что это может сработать для меня.Если это не способ сделать это, не стесняйтесь говорить об этом, и я пока отклоню эту идею, пока не смогу провести дополнительные исследования и написать код.

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

, полный текст кода приведен ниже.При запуске я сразу же получаю ошибку во время выполнения, которая при отладке выделяет первый раздел и заявляет, что «запрос с именем« Pipeline Working »уже существует.« Pipeline Working »- это имя папки, в которой содержатся рабочие книги для импорта,оттуда я уже потерян.

Любая помощь приветствуется. 

Sub PipelinePredictions()
'
' PipelinePredictions Macro
' Import Data from File for Pipeline Predictions
'

'
    ActiveWorkbook.Queries.Add Name:="Pipeline Working", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Folder.Files(""\\hofileserver\Accounts\ACCOUNTS\Lettings Stats 2018 Qtr 4\Pipelines\Pipeline Working"")," & Chr(13) & "" & Chr(10) & "    #""Filtered Hidden Files1"" = Table.SelectRows(Source, each [Attributes]?[Hidden]? <> true)," & Chr(13) & "" & Chr(10) & "    #""Invoke Custom Function1"" = Table.AddColumn(#""Filtered Hidden Files1"", ""Transform File from Pipeline Working"", each #""Transform File f" & _
        "rom Pipeline Working""([Content]))," & Chr(13) & "" & Chr(10) & "    #""Renamed Columns1"" = Table.RenameColumns(#""Invoke Custom Function1"", {""Name"", ""Source.Name""})," & Chr(13) & "" & Chr(10) & "    #""Removed Other Columns1"" = Table.SelectColumns(#""Renamed Columns1"", {""Source.Name"", ""Transform File from Pipeline Working""})," & Chr(13) & "" & Chr(10) & "    #""Expanded Table Column1"" = Table.ExpandTableColumn(#""Removed Other Columns" & _
        "1"", ""Transform File from Pipeline Working"", Table.ColumnNames(#""Transform File from Pipeline Working""(#""Sample File"")))," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(#""Expanded Table Column1"",{{""Source.Name"", type text}, {""Column1"", type any}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type number}" & _
        ", {""Column6"", Percentage.Type}, {""Column7"", Int64.Type}, {""Column8"", type number}, {""Column9"", type number}, {""Column10"", type number}, {""Column11"", type any}, {""Column12"", type datetime}, {""Column13"", type text}})," & Chr(13) & "" & Chr(10) & "    #""Renamed Columns"" = Table.RenameColumns(#""Changed Type"",{{""Source.Name"", ""Branch""}, {""Column1"", ""Week Booked""}, {""Col" & _
        "umn2"", ""Neg""}, {""Column3"", ""Property""}, {""Column4"", ""Service Type""}, {""Column5"", ""Rent""}, {""Column6"", ""Percentage Fee""}, {""Column7"", ""Term""}, {""Column8"", ""Fee""}, {""Column9"", ""Admin""}, {""Column10"", ""Total Fees""}, {""Column11"", ""Rent G'tee""}})," & Chr(13) & "" & Chr(10) & "    #""Changed Type1"" = Table.TransformColumnTypes(#""Renamed Columns"",{{""Column12" & _
        """, type date}})," & Chr(13) & "" & Chr(10) & "    #""Renamed Columns2"" = Table.RenameColumns(#""Changed Type1"",{{""Column12"", ""Move in Date""}, {""Column13"", ""Notes""}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Renamed Columns2"""
    ActiveWorkbook.Queries.Add Name:="Sample File Parameter1", Formula:= _
        "#""Sample File"" meta [IsParameterQuery=true, BinaryIdentifier=#""Sample File"", Type=""Binary"", IsParameterQueryRequired=true]"
    ActiveWorkbook.Queries.Add Name:= _
        "Transform Sample File from Pipeline Working", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.Workbook(#""Sample File Parameter1"", null, true)," & Chr(13) & "" & Chr(10) & "    #""'A Pipeline$'Print_Area1"" = Source{[Name=""'A Pipeline$'Print_Area""]}[Data]" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""'A Pipeline$'Print_Area1"""
    ActiveWorkbook.Queries.Add Name:="Sample File", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Folder.Files(""\\hofileserver\Accounts\ACCOUNTS\Lettings Stats 2018 Qtr 4\Pipelines\Pipeline Working"")," & Chr(13) & "" & Chr(10) & "    Navigation1 = Source{0}[Content]" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    Navigation1"
    ActiveWorkbook.Queries.Add Name:="Transform File from Pipeline Working", _
        Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = (#""Sample File Parameter1"") => let" & Chr(13) & "" & Chr(10) & "        Source = Excel.Workbook(#""Sample File Parameter1"", null, true)," & Chr(13) & "" & Chr(10) & "        #""'A Pipeline$'Print_Area1"" = Source{[Name=""'A Pipeline$'Print_Area""]}[Data]" & Chr(13) & "" & Chr(10) & "    in" & Chr(13) & "" & Chr(10) & "        #""'A Pipeline$'Print_Area1""" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    Source"
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Pipeline Working"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Pipeline Working]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_ExternalData_1"
        .Refresh BackgroundQuery:=False
    End With
    Workbooks("Book1").Connections.Add2 "Query - Sample File Parameter11", _
        "Connection to the 'Sample File Parameter1' query in the workbook.", _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Sample File Parameter1"";Extended Properties=""""" _
        , "SELECT * FROM [Sample File Parameter1]", 2
    Workbooks("Book1").Connections.Add2 _
        "Query - Transform Sample File from Pipeline Working1", _
        "Connection to the 'Transform Sample File from Pipeline Working' query in the workbook." _
        , Array( _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Transform Sample File from Pipeline Working"";Extended Propert" _
        , "ies="""""), "SELECT * FROM [Transform Sample File from Pipeline Working]", 2
    Workbooks("Book1").Connections.Add2 "Query - Sample File1", _
        "Connection to the 'Sample File' query in the workbook.", _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Sample File"";Extended Properties=""""" _
        , "SELECT * FROM [Sample File]", 2
    Workbooks("Book1").Connections.Add2 _
        "Query - Transform File from Pipeline Working1", _
        "Connection to the 'Transform File from Pipeline Working' query in the workbook." _
        , _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Transform File from Pipeline Working"";Extended Properties=""""" _
        , "SELECT * FROM [Transform File from Pipeline Working]", 2
    Windows("Book3").Activate
    Range("A1").Select
End Sub

1 Ответ

0 голосов
/ 03 января 2019

Это открывает все рабочие книги в папке и копирует диапазон, называемый областью печати, в текущую электронную таблицу - предполагается, что этот код находится в пустой рабочей книге 

Sub ImportData()
 Const FolderToImport = "C:\Pipeline Working\" 'adjust as suits - keep last \ at end
 Dim s As String
 s = Dir(FolderToImport & "*.xl??")
 Do While s <> ""
       Dim wb As Workbook
       Set wb = Workbooks.Open(FolderToImport & s, False, True)
       wb.Sheets(1).Range("print area").Copy Destination:= _
         ThisWorkbook.Worksheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
       wb.Close False
       s = Dir()
  Loop
End Sub
...