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するだけなので、ファイルを削除するコードは必要ありません。trueCreateTextFile()

私はこれをテストしましたが、ファイルが書き込まれる問題は発生していません。元のエクスポートに基づいて、データセットに匹敵する可能性のあるデータセットを作成しようとしましたが、問題なく機能します。

于 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 に答える