vba - 有没有一种方法可以导出 Excel 工作表而不复制到工作簿？

Question

我有一个工作簿，可以将工作表导出到 .csv，但它会在保存之前将其复制到新工作簿中一秒钟，我想知道是否有一种方法可以直接从工作表中复制数据而无需打开新的工作表作业簿？我的代码是:

        Sub CopyToCSV()

        Dim FlSv As Variant
        Dim MyFile As String
        Dim sh As Worksheet
        Dim MyFileName As String
        Dim DateString As String

Application.ScreenUpdating = False

        DateString = Format(Now(), "dd-mm-yyyy_hh-mm-ss-AM/PM") '<~~ uses current time from computer clock down to the second
        MyFileName = "Results - " & DateString

        Set sh = Sheets("Sheet1")
        sh.Copy
        FlSv = Application.GetSaveAsFilename(MyFileName, fileFilter:="CSV (Comma delimited) (*.csv), *.csv", Title:="Where should we save this?")

     If FlSv = False Then GoTo UserCancel Else GoTo UserOK

UserCancel:             '<~~ this code is run if the user cancels out the file save dialog
        ActiveWorkbook.Close (False)
        MsgBox "Export Canceled"
        Exit Sub

UserOK:                 '<~~ this code is run if user proceeds with saving the file (clicks the OK button)
        MyFile = FlSv
        With ActiveWorkbook
            .SaveAs (MyFile), FileFormat:=xlCSV, CreateBackup:=False
            .Close False
        End With

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

    End Sub

Answer 1

试试这个(在简单的数据集上测试)

Private Sub ExportToCsv()
    Dim ws As Worksheet
    Dim delim As String, LastCol As String, csvFile As String, CsvLine As String
    Dim aCell As Range, DataRange As Range
    Dim ff As Long, lRow As Long, lCol As Long
    Dim i As Long, j As Long

    '~~> We use "," as delimiter
    delim = ","

    '~~> Change this to specify your file name and path
    csvFile = "C:\Users\Siddharth\Desktop\Sample.Csv"

    '~~> Change this to the sheet which you want to export as csv
    Set ws = ThisWorkbook.Sheets("Sheet9")

    With ws
        '~~> Find last row and last column
        lRow = .Cells.Find(What:="*", _
                After:=.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

        lCol = .Cells.Find(What:="*", _
                After:=.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Column

        '~~> Column number to column letter
        LastCol = Split(Cells(, lCol).Address, "$")(1)

        '~~> This is the range which will be exported
        Set DataRange = .Range("A1:" & LastCol & lCol)

        '
        '~~> Loop through cells in the range and write to text file
        '

        ff = FreeFile

        Open csvFile For Output As #ff

        For i = 1 To lRow
            For j = 1 To lCol
                CsvLine = CsvLine & (delim & Replace(.Cells(i, j).Value, """", """"""""))
            Next j

            Print #ff, Mid(CsvLine, 2)

            CsvLine = ""
        Next

        '~~> Close text file
        Close #ff
    End With
End Sub