Page 1 of 2 12 LastLast
Results 1 to 15 of 20
  1. #1
    Join Date
    Oct 2002
    Location
    UK
    Posts
    4

    Unanswered: How do I write # to a txt file without carriage returns

    I have to export records to a text file delimited with + : and ' (don't ask me - its 80s Electronic Data Interchange standard)

    A lot of data has to be calculated and passed to the text file BUT there can be NO carriage returns.

    Do I really have to collate all the data and "write #" it at once? Unlikely that I can achieve it with the data anyway - it will need to be looped around a varying number of lines and fields.

    I have written my reading script which can strip out the correct data into its relevant fields - I did this by reading one character at a time. Is there anyway I can put 1 character at a time? (I would prefer to place a field at a time then the separator)

  2. #2
    Join Date
    Oct 2001
    Location
    Chicago
    Posts
    440
    This example will export a recordset to a file without carriage returns. Bsically - build the string and write once. It will also check the recordset for a memo field and if fount, it will check for and remove carriage returns.

    Matt



    Private Sub cmdExport_Click()
    Dim fOK As Boolean
    fOK = TextExport("", "TableName", "C:\CarraigeReturnExport.csv")
    If fOK Then
    Call MsgBox( _
    "The recordset was successfully exported.", _
    vbOKOnly + vbInformation + vbDefaultButton1, _
    "Success")
    Else
    Call MsgBox( _
    "The recordset was not successfully exported.", _
    vbOKOnly + vbExclamation + vbDefaultButton1, _
    "Errors")
    End If
    End Sub

    Function TextExport(strTable As String, strExportFile As String) As Boolean

    Dim strText As String
    Dim intFreeFile As Integer
    Dim intCounter As Integer
    Dim rst As DAO.Recordset
    Dim dbs As DAO.Database

    On Error GoTo PROC_ERR

    Set dbs = CurrentDb()

    ' Set Delimiter
    strDelimiter = "+:'"

    ' Kill the file
    On Error Resume Next
    Kill strExportFile
    On Error GoTo PROC_ERR

    ' Open the file
    intFreeFile = FreeFile
    Open strExportFile For Append As intFreeFile

    ' Open the recordset
    Set rst = dbs.OpenRecordset(strTable, dbOpenSnapshot)

    With rst
    'append the header row
    For intCounter = 0 To .Fields.Count - 1
    strText = strText & .Fields(intCounter).Name
    If intCounter < .Fields.Count - 1 Then
    strText = strText & strDelimiter
    End If
    Next

    'now the records
    Do Until .EOF
    For intCounter = 0 To .Fields.Count - 1
    If .Fields(intCounter).TYPE = dbMemo Then
    strText = strText & RemoveCharReturn(Nz(.Fields(intCounter).VALUE))
    Else
    strText = strText & .Fields(intCounter).VALUE
    End If
    If intCounter < .Fields.Count - 1 Then
    strText = strText & strDelimiter
    End If
    Next intCounter
    .MoveNext
    Loop

    End With
    Print #intFreeFile, strText

    'clean up
    Close #intFreeFile
    rst.Close
    Set rst = Nothing
    dbs.Close
    Set dbs = Nothing

    TextExport = True

    PROC_EXIT:
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    TextExport = False
    Resume PROC_EXIT

    End Function

    Function RemoveCharReturn(sString As String) As String

    Const CHAR_RETURN = 13
    Const LINE_FEED = 10

    On Error GoTo PROC_ERR
    If Nz(sString) > "" Then
    While InStr(sString, Chr(CHAR_RETURN)) > 0
    sString = RemoveString(sString, CHAR_RETURN)
    Wend
    While InStr(sString, Chr(LINE_FEED)) > 0
    sString = RemoveString(sString, LINE_FEED)
    Wend
    End If

    PROC_EXIT:
    RemoveCharReturn = Nz(sString, "")
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    Resume PROC_EXIT

    End Function


    Function RemoveString(strData As String, CharFind As Integer) As String

    Dim strTemp1 As String, strTemp2 As String

    On Error GoTo PROC_ERR

    If InStr(strData, Chr(CharFind)) > 0 Then
    strTemp1 = Left(strData, InStr(strData, Chr(CharFind)) - 1)
    strTemp2 = Mid(strData, InStr(strData, Chr(CharFind)) + Len(Chr(CharFind)))
    strData = strTemp1 & strTemp2
    End If

    PROC_EXIT:
    RemoveString = strData
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    Resume PROC_EXIT

    End Function

  3. #3
    Join Date
    Mar 2003
    Posts
    11

    Exclamation Have carriage returns in the txt file...

    What do I need to remove from this code, which allows me to have CARRIAGE returns?

    Cheers

    Will

    CODE:

    Function TextExport(strTable As String, strExportFile As String) As Boolean

    Dim strText As String
    Dim intFreeFile As Integer
    Dim intCounter As Integer
    Dim rst As DAO.Recordset
    Dim dbs As DAO.Database

    On Error GoTo PROC_ERR

    Set dbs = CurrentDb()

    ' Set Delimiter
    strDelimiter = "+:'"

    ' Kill the file
    On Error Resume Next
    Kill strExportFile
    On Error GoTo PROC_ERR

    ' Open the file
    intFreeFile = FreeFile
    Open strExportFile For Append As intFreeFile

    ' Open the recordset
    Set rst = dbs.OpenRecordset(strTable, dbOpenSnapshot)

    With rst
    'append the header row
    For intCounter = 0 To .Fields.Count - 1
    strText = strText & .Fields(intCounter).Name
    If intCounter < .Fields.Count - 1 Then
    strText = strText & strDelimiter
    End If
    Next

    'now the records
    Do Until .EOF
    For intCounter = 0 To .Fields.Count - 1
    If .Fields(intCounter).TYPE = dbMemo Then
    strText = strText & RemoveCharReturn(Nz(.Fields(intCounter).VALUE))
    Else
    strText = strText & .Fields(intCounter).VALUE
    End If
    If intCounter < .Fields.Count - 1 Then
    strText = strText & strDelimiter
    End If
    Next intCounter
    .MoveNext
    Loop

    End With
    Print #intFreeFile, strText

    'clean up
    Close #intFreeFile
    rst.Close
    Set rst = Nothing
    dbs.Close
    Set dbs = Nothing

    TextExport = True

    PROC_EXIT:
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    TextExport = False
    Resume PROC_EXIT

    End Function

    Function RemoveCharReturn(sString As String) As String

    Const CHAR_RETURN = 13
    Const LINE_FEED = 10

    On Error GoTo PROC_ERR
    If Nz(sString) > "" Then
    While InStr(sString, Chr(CHAR_RETURN)) > 0
    sString = RemoveString(sString, CHAR_RETURN)
    Wend
    While InStr(sString, Chr(LINE_FEED)) > 0
    sString = RemoveString(sString, LINE_FEED)
    Wend
    End If

    PROC_EXIT:
    RemoveCharReturn = Nz(sString, "")
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    Resume PROC_EXIT

    End Function


    Function RemoveString(strData As String, CharFind As Integer) As String

    Dim strTemp1 As String, strTemp2 As String

    On Error GoTo PROC_ERR

    If InStr(strData, Chr(CharFind)) > 0 Then
    strTemp1 = Left(strData, InStr(strData, Chr(CharFind)) - 1)
    strTemp2 = Mid(strData, InStr(strData, Chr(CharFind)) + Len(Chr(CharFind)))
    strData = strTemp1 & strTemp2
    End If

    PROC_EXIT:
    RemoveString = strData
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    Resume PROC_EXIT

    End Function

  4. #4
    Join Date
    Oct 2002
    Location
    Leicester - UK
    Posts
    820
    i think thats your best bet the other method require a fixed record length and tend to store numbers in binary not ascii
    Definition of a Beginner, Someone who doesn't know the rules.

    Definition of an Expert, Someone who knows when to ignore the rules.

  5. #5
    Join Date
    Mar 2003
    Posts
    11
    Originally posted by m.timoney
    i think thats your best bet the other method require a fixed record length and tend to store numbers in binary not ascii
    This code gives me the outpit I want, all I need to do is give me carriage returns after each record...

    Will

  6. #6
    Join Date
    Oct 2001
    Location
    Chicago
    Posts
    440
    Append the Vb constant - vbCr

    Print #intFreeFile, strText & vbCr

    other contstants (vbCrLf, vbLf, vbTab)


    Matt

  7. #7
    Join Date
    Mar 2003
    Posts
    11
    Originally posted by Rockey
    Append the Vb constant - vbCr

    Print #intFreeFile, strText & vbCr

    other contstants (vbCrLf, vbLf, vbTab)


    Matt
    I added "& vbCR" but it still not putting a carriage return???


    Will

  8. #8
    Join Date
    Oct 2002
    Location
    Leicester - UK
    Posts
    820
    Originally posted by wilhelm
    I added "& vbCR" but it still not putting a carriage return???


    Will
    try vbCrLf
    Definition of a Beginner, Someone who doesn't know the rules.

    Definition of an Expert, Someone who knows when to ignore the rules.

  9. #9
    Join Date
    Mar 2003
    Posts
    11
    Originally posted by m.timoney
    try vbCrLf
    This is my code below, and the output is still not got a carriage return after each record...have I missed something else???

    Cheers for the responses so far.

    Will

    Function TextExport(strTable As String, strExportFile As String) As Boolean

    Dim strText As String
    Dim intFreeFile As Integer
    Dim intCounter As Integer
    Dim rst As DAO.Recordset
    Dim dbs As DAO.Database
    Dim strDelimiter As String

    On Error GoTo PROC_ERR

    Set dbs = CurrentDb()

    ' Set Delimiter
    strDelimiter = ","

    ' Kill the file
    On Error Resume Next
    Kill strExportFile
    On Error GoTo PROC_ERR

    ' Open the file
    intFreeFile = FreeFile
    Open strExportFile For Append As intFreeFile

    ' Open the recordset
    Set rst = dbs.OpenRecordset(strTable, dbOpenSnapshot)

    With rst
    'append the header row
    For intCounter = 0 To .Fields.Count - 1
    strText = strText & .Fields(intCounter).Name
    If intCounter < .Fields.Count - 1 Then
    strText = strText & strDelimiter
    End If
    Next

    'now the records
    Do Until .EOF
    For intCounter = 0 To .Fields.Count - 1
    If .Fields(intCounter).Type = dbMemo Then
    strText = strText & RemoveCharReturn(Nz(.Fields(intCounter).Value))
    Else
    strText = strText & .Fields(intCounter).Value
    End If
    If intCounter < .Fields.Count - 1 Then
    strText = strText & strDelimiter
    End If
    Next intCounter
    .MoveNext
    Loop

    End With
    '& Chr(13)
    Print #intFreeFile, strText & vbCrLf

    'clean up
    Close #intFreeFile
    rst.Close
    Set rst = Nothing
    dbs.Close
    Set dbs = Nothing

    TextExport = True

    PROC_EXIT:
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    TextExport = False
    Resume PROC_EXIT

    End Function

  10. #10
    Join Date
    Oct 2002
    Location
    Leicester - UK
    Posts
    820
    Sub makefile()
    Open "H:/mdbfiles/helpdesk.dat" For Output As #1
    Write #1, "data","data"
    Write #1, "data"
    Close #1
    End Sub


    this creates the file
    "data","data"
    "data"


    to read use
    Open "H:/mdbfiles/helpdesk.dat" For Input As #1
    Input #1, temp, temp1
    Input #1, temp2
    Close #1
    Definition of a Beginner, Someone who doesn't know the rules.

    Definition of an Expert, Someone who knows when to ignore the rules.

  11. #11
    Join Date
    Oct 2002
    Location
    Leicester - UK
    Posts
    820
    and with this method you don't need the kill statement as it overright the old fill and doesn't append on the end of it
    Definition of a Beginner, Someone who doesn't know the rules.

    Definition of an Expert, Someone who knows when to ignore the rules.

  12. #12
    Join Date
    Mar 2003
    Posts
    11
    Originally posted by m.timoney
    and with this method you don't need the kill statement as it overright the old fill and doesn't append on the end of it
    What the code does is what I want, it just getting it to get my a return...

    Ideas in regards to that code?

    Cheers

    Will

  13. #13
    Join Date
    Oct 2002
    Location
    Leicester - UK
    Posts
    820
    Originally posted by wilhelm
    What the code does is what I want, it just getting it to get my a return...

    Ideas in regards to that code?

    Cheers

    Will
    let me clarify what i ment i don't know how print works but write always puts a Cr after the record i also can't get you code to work with out making more adjustment ot it than i have time to fiddle for a start i don't have you function RemoveCharReturn(Nz(.Fields(intCounter).Value)) or your tables
    Definition of a Beginner, Someone who doesn't know the rules.

    Definition of an Expert, Someone who knows when to ignore the rules.

  14. #14
    Join Date
    Mar 2003
    Posts
    11
    Originally posted by m.timoney
    let me clarify what i ment i don't know how print works but write always puts a Cr after the record i also can't get you code to work with out making more adjustment ot it than i have time to fiddle for a start i don't have you function RemoveCharReturn(Nz(.Fields(intCounter).Value)) or your tables
    Here is what is in my module file:

    Function TextExport(strTable As String, strExportFile As String) As Boolean

    Dim strText As String
    Dim intFreeFile As Integer
    Dim intCounter As Integer
    Dim rst As DAO.Recordset
    Dim dbs As DAO.Database
    Dim strDelimiter As String

    On Error GoTo PROC_ERR

    Set dbs = CurrentDb()

    ' Set Delimiter
    strDelimiter = ","

    ' Kill the file
    On Error Resume Next
    Kill strExportFile
    On Error GoTo PROC_ERR

    ' Open the file
    intFreeFile = FreeFile
    Open strExportFile For Append As intFreeFile

    ' Open the recordset
    Set rst = dbs.OpenRecordset(strTable, dbOpenSnapshot)

    With rst
    'append the header row
    For intCounter = 0 To .Fields.Count - 1
    strText = strText & .Fields(intCounter).Name
    If intCounter < .Fields.Count - 1 Then
    strText = strText & strDelimiter
    End If
    Next

    'now the records
    Do Until .EOF
    For intCounter = 0 To .Fields.Count - 1
    If .Fields(intCounter).Type = dbMemo Then
    strText = strText & RemoveCharReturn(Nz(.Fields(intCounter).Value))
    Else
    strText = strText & .Fields(intCounter).Value
    End If
    If intCounter < .Fields.Count - 1 Then
    strText = strText & strDelimiter
    End If
    Next intCounter
    .MoveNext
    Loop

    End With
    '& Chr(13)
    Print #intFreeFile, strText, vbCr

    'clean up
    Close #intFreeFile
    rst.Close
    Set rst = Nothing
    dbs.Close
    Set dbs = Nothing

    TextExport = True

    PROC_EXIT:
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    TextExport = False
    Resume PROC_EXIT

    End Function

    Function RemoveCharReturn(sString As String) As String

    Const CHAR_RETURN = 13
    Const LINE_FEED = 10

    On Error GoTo PROC_ERR
    If Nz(sString) > "" Then
    While InStr(sString, Chr(CHAR_RETURN)) > 0
    sString = RemoveString(sString, CHAR_RETURN)
    Wend
    While InStr(sString, Chr(LINE_FEED)) > 0
    sString = RemoveString(sString, LINE_FEED)
    Wend
    End If

    PROC_EXIT:
    RemoveCharReturn = Nz(sString, "")
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    Resume PROC_EXIT

    End Function


    Function RemoveString(strData As String, CharFind As Integer) As String

    Dim strTemp1 As String, strTemp2 As String

    On Error GoTo PROC_ERR

    If InStr(strData, Chr(CharFind)) > 0 Then
    strTemp1 = Left(strData, InStr(strData, Chr(CharFind)) - 1)
    strTemp2 = Mid(strData, InStr(strData, Chr(CharFind)) + Len(Chr(CharFind)))
    strData = strTemp1 & strTemp2
    End If

    PROC_EXIT:
    RemoveString = strData
    Exit Function

    PROC_ERR:
    MsgBox Err.Description
    Resume PROC_EXIT

    End Function


    I call it like this from the FORM

    Private Sub cmdExport_Click()
    Dim fOK As Boolean
    fOK = TextExport("tblDetails", "C:\Export.csv")
    If fOK Then
    Call MsgBox( _
    "The recordset was successfully exported.", _
    vbOKOnly + vbInformation + vbDefaultButton1, _
    "Success")
    Else
    Call MsgBox( _
    "The recordset was not successfully exported.", _
    vbOKOnly + vbExclamation + vbDefaultButton1, _
    "Errors")
    End If
    End Sub

    Then just a table with simple data

    ID,Name,Department

    Would that help you?

  15. #15
    Join Date
    Oct 2002
    Location
    Leicester - UK
    Posts
    820
    i get the cr return with Print #intFreeFile, strText & vbCrLf
    now is your problem that the end of the string is the wrong place

    ie you don't want this
    ID,name,department<id1>,<Name1>,<Dept1><id2>,<Name 2>,<Dept2>vbCrLf

    you do want this
    ID,name,department vbCrLf
    <id1>,<Name1>,<Dept1> vbCrLf
    <id2>,<Name2>,<Dept2>vbCrLf
    Definition of a Beginner, Someone who doesn't know the rules.

    Definition of an Expert, Someone who knows when to ignore the rules.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •