INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Format Text Files in a Folder

Format Text Files in a Folder

(OP)
Hello, I have some code here that I have been using to format a single text file by stripping out all the junk I don't want in the file. This works great, but now I want to just do this process for ALL text files in a folder. I was trying to add a loop but keep getting errors at the "InFile" line. I don't think I am understanding how this needs to be done. Any help would be great along with some explanation of how it works!

CODE

Dim InputFile
Dim outFile

' Writing Data to a Text File
Const ForReading = 1
Dim words(1)
Dim msg

words(0) = "#C"

Set objFSO = CreateObject("Scripting.FileSystemObject")
InputFile = InputBox("Enter the you want to format: ")
Set inFile = objFSO.OpenTextFile("c:\80-230\" & InputFile & ".txt", ForReading)
'Set outFile = objFSO.OpenTextFile("c:\Temp2\output.txt", 8, True)
Set outFile = objFSO.OpenTextFile("c:\80-230\" & InputFile & "-Formatted.txt", 8, True)

Do Until inFile.AtEndOfStream
    strSearchString = inFile.ReadLine
	For i = 0 To UBound(words)-1
	If InStr(strSearchString,words(i)) Then
		msg = msg & Mid(Split(strSearchString,";")(0),4) & vbCrLf
	End If
	next
Loop

inFile.Close
outfile.WriteLine msg
outFile.Close

'Stripped file complete

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

'Const ForReading = 1
Const ForWriting = 2

Set objNetwork = CreateObject("Wscript.Network")


strFile1 = "C:\80-230\" & InputFile & "-Formatted.txt"
strFile2 = "C:\80-230\NoDuplicates- " & InputFile & ".txt"

If Not objFSO.FileExists(strFile1) Then
	MsgBox "Input File does not exist, Make the text file called" &_
			" input.txt and try again!", vbOKOnly, "Error"
	WScript.Quit
End If


Set objFile = objFSO.OpenTextFile(strFile1, ForReading)


If Not objFSO.FileExists(strFile2) Then
	objFSO.CreateTextFile(strFile2)
End If


result = MsgBox("Are you just removing the blank lines", vbYesNo)

Select Case result

    Case vbYes
    
        Do Until objFile.AtEndOfStream
            strLine = objFile.Readline
            strLine = Trim(strLine)           
                If Len(strLine) > 0 Then
                    If Not LCase(Left(strLine, 7)) = "version" Then
                        strNewContents = strNewContents & strLine & vbCrLf
                    End If
                End If
        Loop
        
    Case vbNo
    
        Do Until objFile.AtEndOfStream
            strLine = objFile.Readline
            strLine = Trim(strLine)
                If Len(strLine) > 0 Then
                    If Not LCase(Left(strLine, 7)) = "version" Then            
                        strNewContents = strNewContents & "Case" & vbTab & Chr(34) & strLine & Chr(34) & vbCrLf
                    End If
                End If
        Loop
        
End Select

objFile.Close

Set objFile = objFSO.OpenTextFile(strFile1, ForWriting)
objFile.Write strNewContents
objFile.Close


Set objOutputFile = objFSO.OpenTextFile(strFile2, ForWriting, True)
Set objFile = objFSO.OpenTextFile(strFile1, ForReading)
Set Dict = CreateObject("Scripting.Dictionary")

Do until objFile.AtEndOfStream
    strCurrentLine = objFile.ReadLine
	If not Dict.Exists(strCurrentLine) then 
		objOutputFile.WriteLine strCurrentLine
		Dict.Add strCurrentLine,strCurrentLine
	End if 
Loop

objOutputFile.Close
MsgBox"Task completed! ", vbInformation, "Format Files" 

RE: Format Text Files in a Folder

Something like this should help:

CODE

s = "c:\80-230"
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(s)
For Each objInFile in objFolder.Files
   If LCase(objFSO.GetExtensionName(objInFile.Name)) = "txt" Then
      InputFile = objFSO.GetBaseName(objInFile.Name)
      Set inFile = objFSO.OpenTextFile(s & "\" & InputFile & ".txt", ForReading)
      Set outFile = objFSO.OpenTextFile(s & "\" & InputFile & "-Formatted.txt", 8, True)
      
      ... rest of code here ...
      
      
   End If
Next 

RE: Format Text Files in a Folder

(OP)
Thanks guitarzan... I think i'm getting lost once I format the file, then further down I have strFile1 and strFile2. Is there a cleaner way to remove the duplicates from the formatted file? I'm getting an error on line 44 and 45

CODE

Dim inFile, outFile, objFSO, objFolder, objInFile, InputFile

s = "c:\temp"
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(s)
For Each objInFile in objFolder.Files
   If LCase(objFSO.GetExtensionName(objInFile.Name)) = "txt" Then
      InputFile = objFSO.GetBaseName(objInFile.Name)
      Set inFile = objFSO.OpenTextFile(s & "\" & InputFile & ".txt", ForReading)
      Set outFile = objFSO.OpenTextFile(s & "\" & InputFile & "-Formatted.txt", 8, True)
      
      ''... rest of code here ...
	  ' Writing Data to a Text File
Const ForReading = 1
Dim words(1)
Dim msg

words(0) = "#C"

Do Until inFile.AtEndOfStream
    strSearchString = inFile.ReadLine
	For i = 0 To UBound(words)-1
	If InStr(strSearchString,words(i)) Then
		msg = msg & Mid(Split(strSearchString,";")(0),4) & vbCrLf
	End If
	next
Loop

inFile.Close
outfile.WriteLine msg
outFile.Close

'Stripped file complete

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

'Const ForReading = 1
Const ForWriting = 2

Set objNetwork = CreateObject("Wscript.Network")


strFile1 = outFile
strFile2 = outFile & "-NoDuplicates.txt"

If Not objFSO.FileExists(strFile1) Then
	MsgBox "Input File does not exist, Make the text file called" &_
			" input.txt and try again!", vbOKOnly, "Error"
	WScript.Quit
End If


Set objFile = objFSO.OpenTextFile(strFile1, ForReading)


If Not objFSO.FileExists(strFile2) Then
	objFSO.CreateTextFile(strFile2)
End If


result = MsgBox("Are you just removing the blank lines", vbYesNo)

Select Case result

    Case vbYes
    
        Do Until objFile.AtEndOfStream
            strLine = objFile.Readline
            strLine = Trim(strLine)           
                If Len(strLine) > 0 Then
                    If Not LCase(Left(strLine, 7)) = "version" Then
                        strNewContents = strNewContents & strLine & vbCrLf
                    End If
                End If
        Loop
        
    Case vbNo
    
        Do Until objFile.AtEndOfStream
            strLine = objFile.Readline
            strLine = Trim(strLine)
                If Len(strLine) > 0 Then
                    If Not LCase(Left(strLine, 7)) = "version" Then            
                        strNewContents = strNewContents & "Case" & vbTab & Chr(34) & strLine & Chr(34) & vbCrLf
                    End If
                End If
        Loop
        
End Select

objFile.Close

Set objFile = objFSO.OpenTextFile(strFile1, ForWriting)
objFile.Write strNewContents
objFile.Close


Set objOutputFile = objFSO.OpenTextFile(strFile2, ForWriting, True)
Set objFile = objFSO.OpenTextFile(strFile1, ForReading)
Set Dict = CreateObject("Scripting.Dictionary")

Do until objFile.AtEndOfStream
    strCurrentLine = objFile.ReadLine
	If not Dict.Exists(strCurrentLine) then 
		objOutputFile.WriteLine strCurrentLine
		Dict.Add strCurrentLine,strCurrentLine
	End if 
Loop

objOutputFile.Close
MsgBox"Task completed! ", vbInformation, "Format Files"


      
      
   End If
Next 

RE: Format Text Files in a Folder

To fix the error, I think you want something like this.

CODE

strFile1 = InputFile & "-Formatted.txt"
strFile2 = InputFile & outFile & "-NoDuplicates.txt" 

And using a Dictionary object is a good way of eliminating duplicates

RE: Format Text Files in a Folder

(OP)
I still get an error on 'strFile1'. Object doesn't support this property or method. Here is the complete code I am using now. I can't seem to find where the error is.

CODE

Dim InputFile, inFile, outFile, objFSO, msg, strFile1, strFile2
Dim words(1)

Const ForReading = 1
Const ForWriting = 2

words(0) = "#C"

s = "c:\format_text"
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(s)
For Each objInFile in objFolder.Files
   If LCase(objFSO.GetExtensionName(objInFile.Name)) = "txt" Then
      InputFile = objFSO.GetBaseName(objInFile.Name)
      Set inFile = objFSO.OpenTextFile(s & "\" & InputFile & ".txt", ForReading)
      Set outFile = objFSO.OpenTextFile(s & "\" & InputFile & ".Formatted.txt", 8, True)
      
    ''  ... rest of code here ...
	  
	Do Until inFile.AtEndOfStream
    strSearchString = inFile.ReadLine
	For i = 0 To UBound(words)-1
	If InStr(strSearchString,words(i)) Then
		msg = msg & Mid(Split(strSearchString,";")(0),4) & vbCrLf
	End If
	next
Loop

inFile.Close
outfile.WriteLine msg
outFile.Close


strFile1 = InputFile & ".Formatted.txt"
strFile2 = InputFile & outFile & "-NoDuplicates.txt"

If Not objFSO.FileExists(strFile1) Then
	MsgBox "Input File does not exist, Make the text file called" &_
			" input.txt and try again!", vbOKOnly, "Error"
	WScript.Quit
End If


Set objFile = objFSO.OpenTextFile(strFile1, ForReading)


If Not objFSO.FileExists(strFile2) Then
	objFSO.CreateTextFile(strFile2)
End If


result = MsgBox("Are you just removing the blank lines", vbYesNo)

Select Case result

    Case vbYes
    
        Do Until objFile.AtEndOfStream
            strLine = objFile.Readline
            strLine = Trim(strLine)           
                If Len(strLine) > 0 Then
                    If Not LCase(Left(strLine, 7)) = "version" Then
                        strNewContents = strNewContents & strLine & vbCrLf
                    End If
                End If
        Loop
        
    Case vbNo
    
        Do Until objFile.AtEndOfStream
            strLine = objFile.Readline
            strLine = Trim(strLine)
                If Len(strLine) > 0 Then
                    If Not LCase(Left(strLine, 7)) = "version" Then            
                        strNewContents = strNewContents & "Case" & vbTab & Chr(34) & strLine & Chr(34) & vbCrLf
                    End If
                End If
        Loop
        
End Select

objFile.Close

Set objFile = objFSO.OpenTextFile(strFile1, ForWriting)
objFile.Write strNewContents
objFile.Close


Set objOutputFile = objFSO.OpenTextFile(strFile2, ForWriting, True)
Set objFile = objFSO.OpenTextFile(strFile1, ForReading)
Set Dict = CreateObject("Scripting.Dictionary")

Do until objFile.AtEndOfStream
    strCurrentLine = objFile.ReadLine
	If not Dict.Exists(strCurrentLine) then 
		objOutputFile.WriteLine strCurrentLine
		Dict.Add strCurrentLine,strCurrentLine
	End if 
Loop

objOutputFile.Close
'MsgBox"Task completed! ", vbInformation, "Format Files"
   
      
   End If
Next 

RE: Format Text Files in a Folder

(OP)
I'm trying to backup a little and use part of the code to only format the text files but I see it's writing the same information to every file based on the first file in the directory.

CODE

Dim inFile, outFile, objFSO, objFolder, objInFile, InputFile, strFile1, strFile2, msg
Const ForReading = 1
Dim words(1)

words(0) = "#C"

s = "c:\format_text"
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(s)
For Each objInFile in objFolder.Files
   If LCase(objFSO.GetExtensionName(objInFile.Name)) = "txt" Then
      InputFile = objFSO.GetBaseName(objInFile.Name)
      Set inFile = objFSO.OpenTextFile(s & "\" & InputFile & ".txt", ForReading)
      Set outFile = objFSO.OpenTextFile(s & "\" & InputFile & "-Formatted.txt", 8, True)



Do Until inFile.AtEndOfStream
    strSearchString = inFile.ReadLine
	For i = 0 To UBound(words)-1
	If InStr(strSearchString,words(i)) Then
		msg = msg & Mid(Split(strSearchString,";")(0),4) & vbCrLf
	End If
	next
Loop

outfile.WriteLine msg
inFile.Close
outFile.Close

End If
   
Next 

RE: Format Text Files in a Folder

>I still get an error on 'strFile1'.
OK, so you need to include the path

CODE

strFile1 = s & "\" & InputFile & "-Formatted.txt"
strFile2 = s & "\" & InputFile & "-NoDuplicates.txt" 


>...but I see it's writing the same information

CODE

Set objFolder = objFSO.GetFolder(s)
For Each objInFile in objFolder.Files
   If LCase(objFSO.GetExtensionName(objInFile.Name)) = "txt" Then
      InputFile = objFSO.GetBaseName(objInFile.Name)
      Set inFile = objFSO.OpenTextFile(s & "\" & InputFile & ".txt", ForReading)
      Set outFile = objFSO.OpenTextFile(s & "\" & InputFile & "-Formatted.txt", 8, True)

msg = ""

Do Until inFile.AtEndOfStream
    strSearchString = inFile.ReadLine
	For i = 0 To UBound(words)-1
	If InStr(strSearchString,words(i)) Then
		msg = msg & Mid(Split(strSearchString,";")(0),4) & vbCrLf
	End If
	next
Loop

outfile.WriteLine msg
inFile.Close
outFile.Close

End If
   
Next 

RE: Format Text Files in a Folder

(OP)
In this code, the remove duplicates is working but I am still writing the same info to all text files that is in the first text file. I think i'm going crazy trying to understand where this is happening.

CODE

Dim InputFile, inFile, outFile, objFSO, msg, strFile1, strFile2
Dim words(1)

Const ForReading = 1
Const ForWriting = 2

words(0) = "#C"

s = "c:\format_text"
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(s)
For Each objInFile in objFolder.Files
   If LCase(objFSO.GetExtensionName(objInFile.Name)) = "txt" Then
      InputFile = objFSO.GetBaseName(objInFile.Name)
      Set inFile = objFSO.OpenTextFile(s & "\" & InputFile & ".txt", ForReading)
      Set outFile = objFSO.OpenTextFile(s & "\" & InputFile & ".Formatted.txt", 8, True)
     
    msg = ""
	  
	Do Until inFile.AtEndOfStream
    strSearchString = inFile.ReadLine
	For i = 0 To UBound(words)-1
	If InStr(strSearchString,words(i)) Then
		msg = msg & Mid(Split(strSearchString,";")(0),4) & vbCrLf
	End If
	next
Loop

inFile.Close
outfile.WriteLine msg
outFile.Close


strFile1 = s & "\" & InputFile & ".Formatted.txt"
strFile2 = s & "\" & InputFile & "-NoDuplicates.txt"


If Not objFSO.FileExists(strFile1) Then
	MsgBox "Input File does not exist, Make the text file called" &_
			" input.txt and try again!", vbOKOnly, "Error"
	WScript.Quit
End If


Set objFile = objFSO.OpenTextFile(strFile1, ForReading)

    
        Do Until objFile.AtEndOfStream
            strLine = objFile.Readline
            strLine = Trim(strLine)           
                If Len(strLine) > 0 Then
                    If Not LCase(Left(strLine, 7)) = "version" Then
                        strNewContents = strNewContents & strLine & vbCrLf
                    End If
                End If
        Loop
      

objFile.Close

Set objFile = objFSO.OpenTextFile(strFile1, ForWriting)
objFile.Write strNewContents
objFile.Close


Set objOutputFile = objFSO.OpenTextFile(strFile2, ForWriting, True)
Set objFile = objFSO.OpenTextFile(strFile1, ForReading)
Set Dict = CreateObject("Scripting.Dictionary")

Do until objFile.AtEndOfStream
    strCurrentLine = objFile.ReadLine
	If not Dict.Exists(strCurrentLine) then 
		objOutputFile.WriteLine strCurrentLine
		Dict.Add strCurrentLine,strCurrentLine
	End if 
Loop

objOutputFile.Close
   
      
   End If
Next 

RE: Format Text Files in a Folder

It's probably the same problem as with the "msg" variable. You are appending to "strNewContents" with every iteration of your loop. So, set it to a blank string before the loop

RE: Format Text Files in a Folder

(OP)
guitarzan.. I set the 'msg' variable before the loop and still get the same issue. What I notice is that it appends ALL the files as it reads them. I need it to just clean each file and then remove the duplicates. If I run a single file it works great, so somewhere in the loop its getting messed up and i've looked at it a hundred times and I'm not picking up where it is going bad.

RE: Format Text Files in a Folder

I mean that the same fix for "msg" needs to be done for "strNewContents"

CODE

Set objFile = objFSO.OpenTextFile(strFile1, ForReading)

strNewContents = ""
    
        Do Until objFile.AtEndOfStream
            strLine = objFile.Readline
            strLine = Trim(strLine)           
                If Len(strLine) > 0 Then
                    If Not LCase(Left(strLine, 7)) = "version" Then
                        strNewContents = strNewContents & strLine & vbCrLf
                    End If
                End If
        Loop
      

objFile.Close 

RE: Format Text Files in a Folder

(OP)
Wow what a difference. I don't think I would have ever caught that small detail. I think that did it for me... seems to work great. Thanks a lot guitarzan!

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close