Vba 导出到CSV

我想导出到CSV而不是“另存为”，所以创建一个按钮，该按钮将由宏启用。单击时，应在指定目录和指定名称中创建第一张图纸的.csv文件。我的原始工作表应该保留，而不是另存为。

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

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

---

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

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

---

如果重点是保持原始工作簿不变，那么为什么不发挥创意呢。我们可以将工作表复制到另一个工作簿和另存为.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

---

我希望这能有所帮助：）

如果重点是保持原始工作簿不变，那么为什么不发挥创意呢。我们可以将工作表复制到另一个工作簿和另存为.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

---

---

我希望这有帮助：）

为什么不将副本另存为csv？另存为csv只会将一张图纸转换为csv@DavesexcelOP只讨论了一张纸，并没有给出任何想要重新发明这个特殊轮子的理由。没错，因此，没有理由不使用saveas…………也许这个问题会有所帮助：为什么不将副本另存为csv？saveas csv只会将一张图纸转换为csv@DavesexcelOP只讨论了一张纸，并没有给出任何想要重新发明这个特殊轮子的理由。没错，所以没有理由不使用saveas…………也许这个问题会有帮助：让我试试这个，如果这个方法有效，我会给你回复的。好吧，这个方法非常有效，兄弟，正如你所想的那样。谢谢。如果有一种方法可以跳过“是”或“否”按钮来替换现有文件，我们将更加高兴。可能有办法，对吧？我修改了答案，删除了文件，已经有了。因此，现在不会提示您替换该文件。如果这部分中出现错误，则Dir$（strFILE_NAME，vbNormal）=vbNullString然后请注意，该文件的完整路径现在位于此常量strFILE_NAME中。请确保将其更改为您的计算机文件路径。让我尝试一下，如果可行，将返回给您。好的，这非常有效，兄弟，如预期的那样。谢谢。如果有一种方法可以跳过“是”或“否”按钮来替换现有文件，我们将更加高兴。可能有办法，对吧？我修改了答案，删除了文件，已经有了。因此，现在不会提示您替换该文件。如果不是Dir$（strFILE_NAME，vbNormal）=vbNullString，则此部分中会出现一些错误。请注意，文件的完整路径现在位于此常量strFILE_NAME中。请确保将其更改为计算机文件路径。这有助于匹配。但是上面弗雷德提到的那个，非常简单。这有助于配偶。但是上面弗雷德提到的那个，更简单。