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