这里有很多问题要创建一个宏来将工作表保存为CSV文件。所有答案都使用SaveAs,例如来自SuperUser的this one。他们基本上说要创建这样的VBA函数:
Sub SaveAsCSV()
ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub
这是一个很好的答案,但我想要导出而不是另存为。当SaveAs被执行时,它会引起我两个烦恼:
是否可以将当前工作表导出为文件,但继续在原始文件中工作?
@NathanClement有点快。然而,这是完整的代码(稍微复杂一点):
Option Explicit
Public Sub ExportWorksheetAndSaveAsCSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Set shtToExport = ThisWorkbook.Worksheets("Sheet1") 'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False 'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
End Sub
几乎我想要@Ralph。您的代码有一些问题:
为了解决这些问题,并满足我的所有要求,我改编了code from here。我已经清理了一点,使其更具可读性。
Option Explicit
Sub ExportAsCSV()
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Dim Change below to "- 4" to become compatible with .xls files
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
上面的代码还有一些小问题你应该注意到:
.Close
和DisplayAlerts=True
应该是一个finally子句,但我不知道如何在VBA中做到这一点- 5
更改为- 4
。编辑:将Local:=True
保存到我的语言环境CSV分隔符。
根据我对@neves帖子的评论,我通过添加xlPasteFormats以及值部分略微改进了这一点,因此日期作为日期进行 - 我主要将其保存为银行对帐单的CSV,因此需要日期。
Sub ExportAsCSV()
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
'Dim Change below to "- 4" to become compatible with .xls files
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
正如我评论的那样,该网站上有一些地方将工作表的内容写入CSV。 This one和this one只指出了两个。
以下是我的版本
UsedRange
- 因为你想获得工作表中的所有内容代码 ...
Sub makeCSV(theSheet As Worksheet)
Dim iFile As Long, myPath As String
Dim myArr() As Variant, outStr As String
Dim iLoop As Long, jLoop As Long
myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile
myArr = theSheet.UsedRange
For iLoop = LBound(myArr, 1) To UBound(myArr, 1)
outStr = ""
For jLoop = LBound(myArr, 2) To UBound(myArr, 2) - 1
If InStr(1, myArr(iLoop, jLoop), ",") Then
outStr = outStr & """" & myArr(iLoop, jLoop) & """" & ","
Else
outStr = outStr & myArr(iLoop, jLoop) & ","
End If
Next jLoop
If InStr(1, myArr(iLoop, jLoop), ",") Then
outStr = outStr & """" & myArr(iLoop, UBound(myArr, 2)) & """"
Else
outStr = outStr & myArr(iLoop, UBound(myArr, 2))
End If
Print #iFile, outStr
Next iLoop
Close iFile
Erase myArr
End Sub