Is there a faster way to create a txt file?

Question

In my Excel macro, the user would like it to create a txt file of the results. I am able to do so with the code below. At this time, it takes about 5 minutes to create a txt file with 110,000 lines. I'm afraid the user will complain about the time it takes. I'm wondering if their is there a better / faster way to create this txt file?

Thanks in advance for your help....

Sub Create_Text_File()

    Application.ScreenUpdating = False

    ThisBook = ""
    ThisBook = ActiveWorkbook.Name

    Worksheets("Results").Activate
    r = 2

    Dim X As Long
    X = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

    If X > 1 Then

        MyPath = ""
        MyPath = ActiveWorkbook.Path
        MyPath = MyPath & "\"

        Load frmBank
        frmBank.Show

        On Error Resume Next

        Dim efs As Object
        Dim edump As Object
        Dim eWriteString As String
        Dim eRundate

        eRundate = Year(Date)
        If Len(Month(Date)) = 1 Then eRundate = eRundate & 0

        eRundate = eRundate & Month(Date)
        If Len(Day(Date)) = 1 Then eRundate = eRundate & 0

        eRundate = eRundate & Day(Date)
        If Len(Hour(Time)) = 1 Then eRundate = eRundate & 0

        eRundate = eRundate & Hour(Time)
        If Len(Minute(Time)) = 1 Then eRundate = eRundate & 0

        eRundate = eRundate & Minute(Time)
        If Len(Second(Time)) = 1 Then eRundate = eRundate & 0

        eRundate = eRundate & Second(Time)

        Randomize
        eRandom = Int((99999 - 11111 + 1) * Rnd + 11111)

        Set efs = CreateObject("Scripting.FileSystemObject")

        MyFileName = MyPath & MyBank & " - " & eRundate & "-" & eRandom & ".txt"

        Set edump = efs.createtextfile(MyFileName, False)

        Do Until Len(Trim(Cells(r, 1))) + Len(Trim(Cells(r, 2))) + Len(Trim(Cells(r, 3))) = 0

            eString = Chr(34) & Cells(r, 1) & Chr(34) & Chr(44) & Chr(34) & Cells(r, 2) & Chr(34) & Chr(44) & Chr(34) & Cells(r, 3) & Chr(34)

            If Len(Trim(Cells((r + 1), 1))) > 0 Then

                eString = eString & Chr(13) + Chr(10)

            End If

            eWriteString = eString

            edump.Write eWriteString

            r = r + 1

        Loop

        edump.Close

        MsgBox "  The txt file has been created.", vbExclamation, "Txt File Created"

    Else


        MsgBox "  The txt file was not created as there is no data on the 'Results' sheet.", vbCritical, "Txt File Not Created"

    End If

End Sub

Instead of having 110,000+ `edump.Write` operations, why not build one large string and then `edump.Write` the entire string all at once outside of your loop? — Tate Garringer, Feb 06 '19 at 20:07
Why can't you just copy the range to a temporary worksheet and save it as a CSV? I am reading the `eString = Chr(34) & Cells(r, 1) & Chr(34) & Chr(44) & Chr(34) & Cells(r, 2) & Chr(34) & Chr(44) & Chr(34) & Cells(r, 3) & Chr(34)` line correctly, right? — Comintern, Feb 06 '19 at 20:08
@TateGarringer............I'll give that a try and see how it works — Shaves, Feb 06 '19 at 22:02
@Comintern...........The user wants it as a txt file and not a csv file. Can I use this method and save it as a txt file instead? Thanks........ — Shaves, Feb 06 '19 at 22:03
A csv file ***is*** a text file. If they want it named .txt afterward, just rename it. — Comintern, Feb 06 '19 at 22:24
@TateGarringer...........Thanks. Your suggestion worked great and cut the time in half to create the text file. — Shaves, Feb 07 '19 at 15:58

Is there a faster way to create a txt file?

0 Answers0