Is there any way to export and excel sheet without copying to workbook?

I have a workbook that can export a worksheet to .csv, but it copies it to a new workbook for a second before saving im wondering if there is a way to just copy the data from the worksheet, as this does not open a new workbook ? The code I have is:

        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
+4
source share
2 answers

Try it ( tested on a simple data set )

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
+4
source
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
0
source

Source: https://habr.com/ru/post/1678455/


All Articles