如何利用VBA巨集來操作檔案對話框進行開啟檔案和另存新檔 | VBA SUN VBA_FTP_011

[@VBA_SUN]

Sub 巨集002自選()
' 宣告變數
Dim FileOpenPath As String
Dim FileSavePath As String

' 顯示開啟檔案對話框，讓使用者選擇要開啟的檔案
FileOpenPath = Application.GetOpenFilename()

' 檢查使用者是否選擇了檔案（未按取消）
If FileOpenPath "False" Then

' 開啟使用者選擇的文字檔案，並輸入指定設定
Workbooks.OpenText Filename:=FileOpenPath, Origin:=65001, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True

' 顯示另存檔案對話框，讓使用者選擇儲存位置和檔案名稱，設定可另存成 三種
FileSavePath = Application.GetSaveAsFilename( _
FileFilter:="Excel Files (*.xlsx), *.xlsx, Excel 97-2003 Files (*.xls), *.xls, All Files (*.*), *.*", _
Title:="另存為")

' 檢查使用者是否選擇了檔案（即沒有按取消）
If FileSavePath "False" Then

' 根據檔案副檔名選擇適當的 FileFormat 來儲存檔案
If InStr(FileSavePath, ".xlsx") > 0 Then
' 儲存為 .xlsx 格式
ActiveWorkbook.SaveAs FileSavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ElseIf InStr(FileSavePath, ".xls") > 0 Then
' 儲存為 .xls 格式
ActiveWorkbook.SaveAs FileSavePath, FileFormat:=xlExcel8, CreateBackup:=False
Else
MsgBox "不支援的檔案格式！", vbExclamation
End If

' 關閉目前的工作簿
ActiveWindow.Close

Else
MsgBox "你沒有選擇儲存位置，操作取消！", vbExclamation
End If

Else
MsgBox "你沒有選擇檔案，操作取消！", vbExclamation
End If
End Sub