AppleScript将多个Excel文件合并到一个工作表中

Question

我不是AppleScript的专家，因此我试图找到一个成功处理一批Excel文件的AppleScript代码示例（每个包含一个工作表），将每个内容复制到一个目标工作表中。

这是伪代码，我脑子里想的：

pick source folder with Excel files; 
pick destination Excel file; 

for each file within the source folder: 
     copy data from default sheet; 
     paste data into destination sheet's first unused row 
end 

这是我想出了一个代码。它确实打开每个文件，但复制/过去操作只是没有发生。任何想法如何让它工作？

set main_folder to choose folder with prompt "Please select the folder containing the Excel files:" 

set target_excel to choose file with prompt "Please select target Excel file:" 

set excel_extension_list to {"xls", "xlsx", "csv"} 

tell application "Finder" 
    set excel_files to (files of main_folder whose name extension is in excel_extension_list) as alias list 
end tell 

tell application "Microsoft Excel" 
    open target_excel 

    repeat with a_file in excel_files 
     open a_file 
     activate a_file 
     tell sheet 1 of workbook a_file 
      set the_range to value of used range 
      set number_of_source_rows to count of rows of the_range 
     end tell 

     activate target_excel 
     tell sheet 1 of workbook target_excel 
      set new_range to value of used range 
      set number_of_destination_rows to count of rows of new_range 
      set destination_range to range "A" & (number_of_destination_rows + 1) & ":E" & (number_of_destination_rows + 1 + number_of_source_rows) 
      set value of destination_range to the_range 
      close workbook a_file saving no 
     end tell 
    end repeat 
end tell 

Answer 1

尝试，并在Excel测试2011

我的假设

1. 目标文件有一个叫所有的第1张Sheet1
2. 我检索信息表文件。按适用情况更改。

CODE

我评论的代码，所以你不应该有了解它的任何问题。 :)

Sub Sample() 
    Dim wbI As Workbook, wbO As Workbook 
    Dim lRowO As Long 
    Dim lRowI As Long, lColI As Long 
    Dim DestFile As Variant 
    Dim RootFldr As String, FilesFolder As String, strFile As String 

    '~~> Get the Root Folder 
    RootFldr = MacScript("return (path to desktop folder) as String") 

    '~~> Show the Folder Browser to select the folder which has the files 
    FilesFolder = MacScript("(choose folder with prompt ""Please select the folder which has excel files""" & _ 
    "default location alias """ & RootFldr & """) as string") 

    '~~> If user doesn't select anything then exit 
    If FilesFolder = "" Then Exit Sub 

    '~~> Show the File Select dialog for the output file 
    DestFile = Application.GetOpenFilename("XLS8,XLS4") 

    '~~> Open output file 
    Set wbO = Workbooks.Open(DestFile) 

    '~~> Get the next available row for writing 
    lRowO = wbO.Sheets("Sheet1").Cells.Find(What:="*", _ 
      After:=wbO.Sheets("Sheet1").Range("A1"), _ 
      Lookat:=xlPart, _ 
      LookIn:=xlFormulas).Row + 1 

    '~~> Loop through each file in the folder 
    strFile = Dir(FilesFolder) 

    Do While Len(strFile) > 0 
     '~~> Check for the file if it is csv,xls or xlsx 
     If Right(strFile, 3) = "csv" Or _ 
     Right(strFile, 3) = "xls" Or _ 
     Right(strFile, 4) = "xlsx" Then 
      '~~> Open the file from the folder 
      Set wbI = Workbooks.Open(FilesFolder & strFile) 

      With wbI 
       '~~> Get the last row in the file from sheet #1 
       lRowI = .Sheets(1).Cells.Find(What:="*", _ 
         After:=.Sheets(1).Range("A1"), _ 
         Lookat:=xlPart, _ 
         LookIn:=xlFormulas, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlPrevious, _ 
         MatchCase:=False).Row 

       '~~> Get the last column in the file from sheet #1 
       lColI = .Sheets(1).Cells.Find(What:="*", _ 
         After:=.Sheets(1).Range("A1"), _ 
         Lookat:=xlPart, _ 
         LookIn:=xlFormulas, _ 
         SearchOrder:=xlByColumns, _ 
         SearchDirection:=xlPrevious, _ 
         MatchCase:=False).Column 

       With .Sheets(1) 
        '~~> Copy the selected range 
        .Range(.Cells(1, 1), .Cells(lRowI, lColI)).Copy 

        '~~> Paste in destination file 
        wbO.Sheets("Sheet1").Range("A" & lRowO).PasteSpecial xlValues 

        '~~> Get the next available row for writing 
        lRowO = wbO.Sheets("Sheet1").Cells.Find(What:="*", _ 
          After:=wbO.Sheets("Sheet1").Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlFormulas, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious, _ 
          MatchCase:=False).Row + 1 
       End With 
      End With 
      '~~> Close the file after copying from it 
      wbI.Close SaveChanges:=False 
     End If 
     strFile = Dir 
    Loop 

    MsgBox "Done" 
End Sub