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