SAVESA_FileDialog.VBA

gistfile1.txt

Private Sub CommandButton1_Click()
 Application.ScreenUpdating = False
  Application.DisplayStatusBar = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  
    ActiveSheet.Cells.Clear

    Source = Excel.ActiveWorkbook.Name
     
    Dim fd As FileDialog    '宣告一個檔案對話框

    Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker)  '設定選取檔案功能

    Application.DisplayAlerts = False

    fd.Filters.Clear    '清除之前的資料

    fd.InitialFileName = Excel.ActiveWorkbook.Path  '設定預設目錄

    fd.Filters.Add "Excel File", "*.xls*" '設定顯示的副檔名
    fd.Filters.Add "Word File", "*.txt"
    fd.Filters.Add "Word File", "*.csv"
    fd.Filters.Add "所有檔案", "*.*"

    fd.Show '顯示對話框
    
    For I = 1 To fd.SelectedItems.Count
    
        
        strFullName = fd.SelectedItems(I) 'FILE_AA(i)
       
        Workbooks.Open Filename:=strFullName
        
         WORKNAME = Excel.ActiveWorkbook.Name
         
         
        
        Windows(WORKNAME).Activate
        
        ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & WORKNAME & "-NEW" & ".xls", FileFormat:=xlExcel8
        
        WORKNAME = Excel.ActiveWorkbook.Name
        
        Windows(WORKNAME).Close
       
        Windows(Source).Activate
        
        ActiveSheet.Range("A" & I + 1) = WORKNAME
    
    Next
    
    
     Application.ScreenUpdating = True
  Application.DisplayStatusBar = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  
  MsgBox "SAVESA IS DONE "
  
End Sub