有没有一种方法可以将Excel表格导出而不必复制到工作簿中？

Question

有没有一种方法可以将Excel表格导出而不必复制到工作簿中？

4

我有一个工作簿，可以将工作表导出为 .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

- Andrew Walker

谢谢您的回复，这段代码发布在哪里了吗？我想测试一下！ - Andrew Walker

我需要它的原因是因为我使用VaySoft Excel to EXE Converter，这样我的同事就无法窃取我的代码并将其归功于他们自己向我的老板（这种情况已经发生了很多次）。问题在于它保护了工作表并且不允许其他工作簿打开，因此它破坏了导出功能。 - Andrew Walker

1

我不确定它在哪里在线上，因为我把它存在我的代码数据库里 :) - Siddharth Rout

好的，如果你有时间找到它，我会非常感激。我已经完成了另一个工作项目，并且一直在学习Excel中的VB。虽然我不是专家，但我已经成功地让所有东西都运行起来了，除了这个问题。所以，我真的很感激任何帮助。 - Andrew Walker

1

我找不到它，所以我会从头开始编写...给我15分钟。 - Siddharth Rout

显示剩余3条评论

2个回答

0

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

- Dy.Lee

这个也非常好用，太感谢了。当编译为.exe文件时，保存会出现错误400，但实际上保存成功了，有什么想法为什么会出现这种情况吗？ - Andrew Walker

缺少Dim strFile As String。 - Dy.Lee

谢谢，我尝试过了，但结果完全一样。它能够完美运行，但最后会出现400错误。 - Andrew Walker

缺少的是“Dim strTxt As String”，而不是“Dim strFile As String”。 - Dy.Lee

错误代码400，消息为“您无法使用Show方法以模态方式显示可见表单。此错误具有以下原因和解决方案：”。 - Dy.Lee

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Siddharth Rout · Accepted Answer

尝试这个（在简单数据集上测试过）

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