导出为CSV

Question

我想导出为CSV而不是＆＃34;另存为＆＃34;，因此创建一个将由宏启用的按钮。单击时，它应该创建指定目录中第一个工作表的.csv文件以及指定的名称。我的原始工作表应该保留，而不是保存为。

Answer 1

如果重点是保持原始工作簿不变，那么为什么不发挥创意。我们可以将工作表复制到另一个工作簿，另存为.csv

Option Explicit

Sub ExportOneSheet()

    Const strFILE_NAME As String = "C:\Users\Tom\Desktop\tes.csv"

    Dim shToExport As Worksheet

    ' Set the sheet to copy
    Set shToExport = ActiveWorkbook.Sheets("Sheet1")

    ' Make a copy of the sheet, when called without argument
    ' it will create a new workbook
    shToExport.Copy
    Set shToExport = ActiveWorkbook.Sheets("Sheet1")

    ' If the file exists the delete it. This will esure that
    ' there is no previous file so the replace file thing will not show
    If Not Dir$(strFILE_NAME, vbNormal) = vbNullString Then
        Kill strFILE_NAME
    End If

    ' Use Save As and your original workbook stays untouched.
    shToExport.SaveAs strFILE_NAME, XlFileFormat.xlCSV
    shToExport.Parent.Close True

End Sub

我希望这会有所帮助：）

Answer 2

如果你没有在单元格中嵌入逗号，这可能就足够了：

Sub CSV_Maker()
   Dim r As Range
   Dim sOut As String, k As Long, M As Long
   Dim N As Long, nFirstRow As Long, nLastRow As Long

   Sheets(1).Select

   ActiveSheet.UsedRange
   Set r = ActiveSheet.UsedRange
   nLastRow = r.Rows.Count + r.Row - 1
   nFirstRow = r.Row
   Dim separator As String
   separator = ","

   MyFilePath = "C:\TestFolder\"
   MyFileName = "whatever"
   Set fs = CreateObject("Scripting.FileSystemObject")
   Set a = fs.CreateTextFile(MyFilePath & MyFileName & ".csv", True)

   For N = nFirstRow To nLastRow
       k = Application.WorksheetFunction.CountA(Cells(N, 1).EntireRow)
       sOut = ""
       If k = 0 Then
           sOut = vbCrLf
       Else
           M = Cells(N, Columns.Count).End(xlToLeft).Column
           For mm = 1 To M
               sOut = sOut & Cells(N, mm).Value & separator
           Next mm
           sOut = Left(sOut, Len(sOut) - 1)
       End If
       a.writeline (sOut)
   Next

   a.Close
End Sub