VBA：FileDialog+Workbook.SaveAs 另存新檔

 一個朋友跟我說，很多時後掌握基礎比複雜的說明問題更好；今天處理自己工作上的xlsx檔案轉存為xls檔案，用了之前自己寫的FileDialog案例，也做做分享。

作一個按鈕插入以下CODE：

CODE流程：關閉自動運算等功能>宣告物件>對話框>迴圈>開啟檔案>變更檔名>關閉>下一個檔案>離開迴圈>完成對話框顯示

操作流程：點選按鈕>對話框選擇檔案>開始轉換>發呆

	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

view raw gistfile1.txt hosted with ❤ by GitHub

若要修改成其他副檔案名稱：

修改這裡： 設定參考

ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & WORKNAME & "-NEW" & ".xls", FileFormat:=xlExcel8