有没有一种方法可以在不复制工作簿的情况下出口和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:UsersSiddharthDesktopSample.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

Answer 2

Sub CopyToCSV()
        Dim FlSv As Variant
        Dim MyFile As String
        Dim sh As Worksheet
        Dim MyFileName As String
        Dim strTxt As String
        Dim vDB, vR() As String, vTxt()
        Dim i As Long, n As Long, j As Integer
        Dim objStream
        Dim strFile 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
        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)
    Set objStream = CreateObject("ADODB.Stream")
    MyFile = FlSv
    vDB = ActiveSheet.UsedRange
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, ",")
    Next i
    strtxt = Join(vTxt, vbCrLf)
    With objStream
        .Charset = "utf-8"
        .Open
        .WriteText strtxt
        .SaveToFile FlSv, 2
        .Close
    End With
    Set objStream = Nothing
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
End Sub