excel VBA 在 SaveAs 方法中转换为 CSV

Question

我正在尝试改进在此线程中找到的 VBA 以下。 是否可以以Application.Dialogs(xlDialogSaveAs).Show(Arg2:=xlCSV)方法的形式使用此代码，以便我可以选择保存 CSV 文件的位置？

Option Explicit

Sub CSV_Makerr()
   Dim r As Range
   Dim sOut As String, k As Long, M As Long
   Dim N As Long, nFirstRow As Long, nLastRow As Long
   Dim MyFilePath As String, MyFileName As String
   Dim fs, a, mm As Long
   Dim separator As String

   ActiveSheet.UsedRange
   Set r = ActiveSheet.UsedRange
   nLastRow = r.Rows.Count + r.Row - 1
   nFirstRow = r.Row
   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

       Else
           M = Cells(N, Columns.Count).End(xlToLeft).Column
           For mm = 1 To M
               sOut = sOut & Cells(N, mm).Text & separator
           Next mm
           sOut = Left(sOut, Len(sOut) - 1)
           a.writeline (sOut)
       End If
   Next

   a.Close
End Sub

这个想法是从 CSV 或空白列中删除逗号，即使在我多次删除它之后仍然存在。 上面的代码可以工作，但不能自由地为不同的最终用户或 PC 选择位置路径。 请让我知道是否可能。

Answer 1

像这样的东西？

Sub CSV_Makerr()
   Dim r As Range
   Dim sOut As String, k As Long, M As Long
   Dim N As Long, nFirstRow As Long, nLastRow As Long
   Dim MyFilePath As String, MyFileName As String
   Dim fs, a, mm As Long
   Dim separator As String

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

   MyFilePath = Application.GetSaveAsFilename(fileFilter:="CSV Files (*.csv), *.csv")
   If MyFilePath <> "" Then
       Set fs = CreateObject("Scripting.FileSystemObject")
       Set a = fs.CreateTextFile(MyFilePath, True)
    
       For N = nFirstRow To nLastRow
           k = Application.WorksheetFunction.CountA(Cells(N, 1).EntireRow)
           sOut = ""
           If k = 0 Then
    
           Else
               M = Cells(N, Columns.Count).End(xlToLeft).Column
               For mm = 1 To M
                   sOut = sOut & Cells(N, mm).Text & separator
               Next mm
               sOut = Left(sOut, Len(sOut) - 1)
               a.writeline (sOut)
           End If
       Next
       a.Close
   End If
End Sub