要保存为 CSV 格式的文件 iin excel vba
file to saveas CSV format iin excel vba
我已使用以下代码将我的活动工作表保存为 CSV,但在该文件夹中找不到输出文件。代码有什么问题?
供您参考的代码:
Sub Save_CSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
SaveNAme = "INDENTED_BOM"
SavePath = Dir("C:\Users0153\Desktop\AUTOMATION (STRUCTURES)")
Range("A1:D150").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Workbooks.Add
With ActiveSheet.Range("A2")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
ActiveSheet.Columns("A:D").AutoFit
ActiveWorkbook.SaveAs Filename:=SavePath & SaveNAme & ".csv" _
, FileFormat:=xlCSVWindows, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Task Finished", vbInformation, "Finished"
End Sub
不用copy/paste也可以,因为Worksheet
对象有SaveAs
方法,所以没必要做:
- 通过
Workbooks.Add
创建新工作簿
- 从当前工作簿复制单元格区域
- 将复制的选择粘贴到 (1) 中的新工作簿
- 保存 (1) 中的新工作簿
相反,您应该:
- 在工作表上调用
SaveAs
方法
- 删除前面代码中没有复制的行(1-4)
看起来像这样,也进行了修改以确保文件不存在。如果文件已经存在,MsgBox
会提醒您,然后程序将退出 而不会 保存。
Sub SaveAs_CSV()
Dim SaveNAme$, SavePath$, csvFullName$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
SaveNAme = Range("B2")
SavePath = Range("B3")
If Right(SavePath,1) <> Application.PathSeparator Then SavePath = SavePath & Application.PathSeparator
csvFullName = savePath & SaveNAme & ".csv"
If Dir(csvFullName) <> "" Then
'File already exists, alert the user and exit procedure
MsgBox csvFullname & " already exists! The file will not be saved as CSV.", vbInformation
GoTo EarlyExit
End If
ActiveSheet.SaveAs Filename:=csvFullName _
, FileFormat:=xlCSVWindows, CreateBackup:=False
Rows("1:4").EntireRow.Delete
Columns("A:D").AutoFit
ActiveWindow.Close
EarlyExit:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
我已使用以下代码将我的活动工作表保存为 CSV,但在该文件夹中找不到输出文件。代码有什么问题?
供您参考的代码:
Sub Save_CSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
SaveNAme = "INDENTED_BOM"
SavePath = Dir("C:\Users0153\Desktop\AUTOMATION (STRUCTURES)")
Range("A1:D150").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Workbooks.Add
With ActiveSheet.Range("A2")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
ActiveSheet.Columns("A:D").AutoFit
ActiveWorkbook.SaveAs Filename:=SavePath & SaveNAme & ".csv" _
, FileFormat:=xlCSVWindows, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Task Finished", vbInformation, "Finished"
End Sub
不用copy/paste也可以,因为Worksheet
对象有SaveAs
方法,所以没必要做:
- 通过
Workbooks.Add
创建新工作簿
- 从当前工作簿复制单元格区域
- 将复制的选择粘贴到 (1) 中的新工作簿
- 保存 (1) 中的新工作簿
相反,您应该:
- 在工作表上调用
SaveAs
方法 - 删除前面代码中没有复制的行(1-4)
看起来像这样,也进行了修改以确保文件不存在。如果文件已经存在,MsgBox
会提醒您,然后程序将退出 而不会 保存。
Sub SaveAs_CSV()
Dim SaveNAme$, SavePath$, csvFullName$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
SaveNAme = Range("B2")
SavePath = Range("B3")
If Right(SavePath,1) <> Application.PathSeparator Then SavePath = SavePath & Application.PathSeparator
csvFullName = savePath & SaveNAme & ".csv"
If Dir(csvFullName) <> "" Then
'File already exists, alert the user and exit procedure
MsgBox csvFullname & " already exists! The file will not be saved as CSV.", vbInformation
GoTo EarlyExit
End If
ActiveSheet.SaveAs Filename:=csvFullName _
, FileFormat:=xlCSVWindows, CreateBackup:=False
Rows("1:4").EntireRow.Delete
Columns("A:D").AutoFit
ActiveWindow.Close
EarlyExit:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub