Question

我有一些代码可以将数据从电子表格导出到逗号分隔文件。如果我在代码中的任何位置设置了断点，则数据将按预期导出到文件中。如果我没有断点，则创建的文件没有任何数据。认为这是一个时间问题，我在代码中试验了一个等待周期，但这并没有解决问题。这是代码：

Private Sub WriteDataToFile()  
Dim i As Long
Dim iLastRow As Integer
Dim strFile As String
Dim FSO As FileSystemObject
Dim FSOFile As TextStream
Dim strData As String
Dim s As String

strFile = "C:\Temp\DSGELIG.txt"
'  Delete the file if it already exists
DeleteFile (strFile)

'  Determine the last row
iLastRow = 50
For i = 2 To 65000
    strData = Range("B" + CStr(i))
    If Len(strData) < 1 Then
        iLastRow = i - 1
        Exit For
    End If
Next i


'  Create the file system object
Set FSO = New FileSystemObject
Set FSOFile = FSO.OpenTextFile(strFile, ForWriting, True)




For i = 2 To iLastRow
    strData = ""
    With Worksheets(1)
        'Debug.Print Range("B" + CStr(i))
        strData = """"
        '  Patient Name
        strData = strData + Range("B" + CStr(i))
        strData = strData + """" + "," + """"
        '  SSN / Policy #
        strData = strData + Range("C" + CStr(i))
        strData = strData + """" + "," + """"
        '  Birthdate
        strData = strData + CStr(Range("D" + CStr(i)))
        strData = strData + """" + "," + """"
        '  Admit Date
        strData = strData + CStr(Range("E" + CStr(i)))
        strData = strData + """" + "," + """"
        '  Admit Date - 2
        strData = strData + CStr(Range("F" + CStr(i)))
        strData = strData + """" + "," + """"
        '  Account Number
        strData = strData + CStr(Range("G" + CStr(i)))
        strData = strData + """" + "," + """"
        '  Insurance Code
        strData = strData + Range("H" + CStr(i))
        strData = strData + """" + "," + """"
        '  Financial Class
        strData = strData + Range("I" + CStr(i))
        strData = strData + """" + "," + """"
        '  Location
        strData = strData + Range("J" + CStr(i))
        strData = strData + """"

        '  Write the record to the file
        FSOFile.WriteLine (strData)
    End With


Next i

FSOFile.Close

End Sub

感谢您提前 - 自从我做了任何VBA以来已经有一段时间了。

Answer 1

更新了我如何从头开始：

Option Explicit

Sub Test()
    Dim FSO As New FileSystemObject
    Dim ts As TextStream
    Dim WS As Worksheet
    Dim arrData(9) As String
    Dim strFile As String, strData As String
    Dim iLastRow As Integer, i As Integer, j As Integer

    strFile = "C:\Temp\DSGELIG.txt"
    Set ts = FSO.CreateTextFile(strFile, True)
    Set WS = ThisWorkbook.Worksheets(1)
    iLastRow = WS.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    With WS
        For i = 2 To iLastRow
            For j = 2 To 10
                arrData(j - 2) = """" & CStr(.Cells(i, j)) & """"
            Next j

            strData = Join(arrData, ",")
            ts.WriteLine Left(strData, Len(strData) - 1)
        Next i
    End With

    ts.Close

    Set ts = Nothing
    Set FSO = Nothing
End Sub

您的代码无需删除该文件，因为您只需将overwrite设置为true中的CreateTextFile()。

我已对此进行了测试，并且没有遇到写入文件的任何问题。我甚至尝试根据您的原始导出创建一组可能与您的数据相当的数据，并且它可以正常工作。

Answer 2

我重写了一些Kittoes代码，如下：

Sub Test()

    Dim FSO As New FileSystemObject
    Dim ts As TextStream
    Dim strFile As String, strData As String
    Dim iLastRow As Integer, i As Long, c As Long

    strFile = "C:\Temp\DSGELIG.txt"

    '  Determine the last row
    iLastRow = Cells(Rows.Count, 2).End(xlUp).Row

    '  Create the file system object
    Set ts = FSO.CreateTextFile(strFile, True)
    With Worksheets(1)
        For i = 2 To iLastRow
            strData = ""
            For c = 2 To 10
                strData = "'" & strData & .Cells(i, c) & "',"
            Next c

            '  Write the record to the file without the last comma
            ts.WriteLine Left(strData, Len(strData) - 1)
        Next i
    End With

    ts.Close

    Set ts = Nothing
    Set FSO = Nothing

End Sub

我必须说我从未使用过FSO.CreateFile和其他人。我通常使用旧的Print #1语法。如果可以的话，我通常会尽量避免任何其他参考。

导出到文本文件的EXCEL VBA代码仅在设置断点时有效

2 个答案: