3

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

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 了。

4

2 回答 2

3

更新了我如何从头开始执行此操作：

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为truein CreateTextFile()。

我已经对此进行了测试，并且在写入文件时没有遇到任何问题。我什至尝试根据您的原始导出创建一组可能与您的数据相当的数据，并且效果很好。

于 2012-09-20T21:34:24.263 回答
3

我修改了一些 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语法。如果可以的话，我通常会尽量避免任何额外的参考。

于 2012-09-20T22:17:15.453 回答