Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Format Text Files in a Folder 1

Status
Not open for further replies.

Nu2Java

Technical User
Jun 5, 2012
166
US
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"

 
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
 
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
 
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
 
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
 
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
 
>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)

[highlight #FCE94F]msg = ""[/highlight]

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
 
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
 
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
 
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.
 
I mean that the same fix for "msg" needs to be done for "strNewContents"

Code:
Set objFile = objFSO.OpenTextFile(strFile1, ForReading)

[highlight #FCE94F]strNewContents = ""[/highlight]
    
        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
 
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!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top