Results 1 to 6 of 6
  1. #1
    2 Star Lounger
    Join Date
    Mar 2007
    Location
    Wikltshire UK
    Posts
    152
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Find New Line Charecter in Text File (Windows XP/Office 2007)

    OK this is driving me slightly nuts I'm trying to detect what i Presume is a Carriage Return or a new line Charecter in a Text File extracted from Word Documents so I can Structure the Text post Extraction:

    It looks like [] in the text file;

    I've tried: CHR(10) CHR(13) CHR(22) CHR(157) but nothing Any Ideas????

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Find New Line Charecter in Text File (Windows XP/Office 2007)

    It should be carriage return Chr(13) or line feed Chr(10) or a combination of both Chr(13) & Chr(10).

    How do you "extract" the text files from Word documents?
    Could you post a small sample file?

  3. #3
    2 Star Lounger
    Join Date
    Mar 2007
    Location
    Wikltshire UK
    Posts
    152
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Re: Find New Line Charecter in Text File (Windows XP/Office 2007)

    Hans it the Software you Kindly put me onto a Week ago?

    Public Function ConvWord()

    ' Both paths must end in a backslash

    Dim Fsys As New FileSystemObject
    Dim instream As TextStream

    Set ThisFolder = Fsys.GetFolder("Cocuments and SettingsAdminDesktopTXTFiles")
    Set Allfiles = ThisFolder.Files
    For Each File In Allfiles
    'Set instream = Fsys.OpenTextFile(File, 1, False, False)
    Fsys.DeleteFile File, True
    Next

    Const strSource = "Cocuments and SettingsGraemeDesktopDocFiles"
    Const strTarget = "Cocuments and SettingsGraemeDesktopTXTFiles"

    Dim wrdApp As Object
    Dim wrdDoc As Object
    Dim strFile As String
    Dim blnStart As Boolean

    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    If wrdApp Is Nothing Then
    Set wrdApp = CreateObject("Word.Application")
    If wrdApp Is Nothing Then
    MsgBox "Can't start Word!", vbExclamation
    Exit Function
    End If
    blnStart = True
    End If
    On Error GoTo ErrHandler

    strFile = Dir(strSource & "*.doc")
    Do While Not strFile = ""
    Set wrdDoc = wrdApp.Documents.Open(FileName:=strSource & strFile)
    wrdDoc.SaveAs FileName:=strTarget & Replace(strFile, ".doc", ".txt"), _
    FileFormat:=2 ' wdFormatText
    wrdDoc.Close SaveChanges:=False
    strFile = Dir
    Loop

    ExitHandler:
    On Error Resume Next
    wrdDoc.Close SaveChanges:=False
    Set wrdDoc = Nothing
    If blnStart Then
    wrdApp.Quit SaveChanges:=False
    End If
    Set wrdApp = Nothing
    Exit Function

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler

  4. #4
    2 Star Lounger
    Join Date
    Mar 2007
    Location
    Wikltshire UK
    Posts
    152
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Re: Find New Line Charecter in Text File (Windows XP/Office 2007)

    Sorry Scrub That request.

    I was Trying to Mid the ReadLIne Rather than breaking the Stored String to append to a newfile.

    PROBLEM RESOLVED...

  5. #5
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Find New Line Charecter in Text File (Windows XP/Office 2007)

    The line ends in a file created like that are vbCrLf = Chr(13) & Chr(10)

  6. #6
    2 Star Lounger
    Join Date
    Mar 2007
    Location
    Wikltshire UK
    Posts
    152
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Re: Find New Line Charecter in Text File (Windows XP/Office 2007)

    In Case Anyones interested Find My Solution Below: Apologies for lack of Notation:

    Public Function ConvWord()

    ' Both paths must end in a backslash

    Dim Fsys As New FileSystemObject
    Dim Instream As TextStream

    Set ThisFolder = Fsys.GetFolder("Cocuments and SettingsGraemeDesktopTXTFiles")
    Set Allfiles = ThisFolder.Files
    For Each File In Allfiles
    'Set instream = Fsys.OpenTextFile(File, 1, False, False)
    Fsys.DeleteFile File, True
    Next

    Const strSource = "Cocuments and SettingsGraemeDesktopDocFiles"
    Const strTarget = "Cocuments and SettingsGraemeDesktopTXTFiles"

    Dim wrdApp As Object
    Dim wrdDoc As Object
    Dim strFile As String
    Dim blnStart As Boolean

    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    If wrdApp Is Nothing Then
    Set wrdApp = CreateObject("Word.Application")
    If wrdApp Is Nothing Then
    MsgBox "Can't start Word!", vbExclamation
    Exit Function
    End If
    blnStart = True
    End If
    'On Error GoTo ErrHandler

    strFile = Dir(strSource & "*.doc")
    Do While Not strFile = ""
    Set wrdDoc = wrdApp.Documents.Open(FileName:=strSource & strFile)
    wrdDoc.SaveAs FileName:=strTarget & Replace(strFile, ".doc", ".txt"), _
    FileFormat:=2 ' wdFormatText
    wrdDoc.Close SaveChanges:=False
    strFile = Dir
    Loop

    'ExitHandler:
    ' On Error Resume Next
    ' wrdDoc.Close SaveChanges:=False
    ' Set wrdDoc = Nothing
    ' If blnStart Then
    ' wrdApp.Quit SaveChanges:=False
    ' End If
    ' Set wrdApp = Nothing
    ' Exit Function
    '
    'ErrHandler:
    ' MsgBox Err.Description, vbExclamation
    ' Resume ExitHandler


    Dim objFso As FileSystemObject
    Dim Instream2 As TextStream


    Set ThisFolder = Fsys.GetFolder("Cocuments and SettingsAdminDesktopTXTFiles")
    Set Allfiles = ThisFolder.Files

    For Each File In Allfiles
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objfile = objFso.CreateTextFile("C:Tempfilebatch.txt")

    Dim Fresh1 As String
    Dim Fresh2 As String
    Dim FreshQ As String
    Dim Name1 As String
    Dim LineCount As Integer

    Name1 = File.Name
    Set Instream2 = Fsys.OpenTextFile(File, 1, False, False)
    While Instream2.AtEndOfStream = False
    DoEvents
    Tline = Instream2.ReadLine
    Fresh1 = Tline
    If InStr(Fresh1, Chr(13)) = 0 Then
    objfile.WriteLine (Fresh1)
    End If
    LineCount = 0
    While InStr(Fresh1, Chr(13)) > 0
    DoEvents
    FreshQ = 0
    FreshQ = InStr(Fresh1, Chr(13))
    Fresh2 = Left(Fresh1, FreshQ)
    Fresh1 = Mid(Fresh1, FreshQ + 1)
    Fresh2 = Replace(Fresh2, Chr(13), "")
    objfile.WriteLine (Fresh2)
    LineCount = LineCount + 1
    Wend
    If Trim(Len(Fresh1)) > 0 And LineCount > 0 Then
    objfile.WriteLine (Fresh1)
    End If
    Wend
    Set objFso = Nothing
    Set objfile = Nothing
    Set Instream2 = Nothing
    Set Fsys = Nothing

    Kill "Cocuments and SettingsGraemeDesktopTXTFiles" & Name1
    FileCopy "C:Tempfilebatch.txt", "Cocuments and SettingsGraemeDesktopTXTFiles" & Name1
    Kill "C:Tempfilebatch.txt"
    Next

    MsgBox ("Finished Processing")

    End Function

Posting Permissions

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