有没有更快的方法来创建txt文件?

时间:2019-02-06 19:59:37

标签: excel vba fso

在我的Excel宏中,用户希望它创建结果的txt文件。我可以使用下面的代码来做到这一点。目前,创建带有110,000行的txt文件大约需要5分钟。恐怕用户会抱怨所花的时间。我想知道他们是否有更好/更快的方法来创建此txt文件?

预先感谢您的帮助。...

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

0 个答案:

没有答案