PDA

View Full Version : Textfile loop to find/replace characters



qitjch
05-24-2016, 09:00 AM
Hello,

I am trying to create a macro that will loop through an entire directory of text files. For each text file, I want to open it and then find any special characters and replace them with "". The specific character I want to replace looks like a cross 16239

I have a macro currently that will replace the character but I have to specify the file:



Sub looptexttest()




'remove extra characters from text file


Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As Variant


' Edit as needed
sFileName = Application.GetOpenFilename()


If sFileName = False Then
MsgBox "No File Selected", vbExlamation
Worksheets("Summary").Select
Exit Sub
End If


iFileNum = FreeFile
Open sFileName For Input As iFileNum


Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum


sTemp = Replace(sTemp, "", "")


'Save txt file as (if possible)


iFileNum = FreeFile
Open sFileName For Output As iFileNum


Print #iFileNum, sTemp


Close iFileNum


End Sub


I also have a macro that loops through all text files in a directory and is supposed to find/replace; however it does not seem to be working and I cannot figure out why.



Sub FindAndReplaceText()

Dim FileName As String
Dim FolderPath As String
Dim FSO As Object
Dim I As Integer
Dim SearchForWords As Variant
Dim SubstituteWords As Variant
Dim Text As String
Dim TextFile As Object

'Change these arrays to word you want to find and replace
SearchForWords = Array("")
SubstituteWords = Array("")

'Change the folder path to where your text files are.
FolderPath = "\\SVUSINDFILE1\IndyManufacturing\Finance\Daily PPV Reporting\GL Files"

Set FSO = CreateObject("Scripting.FileSystemObject")

FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)
FileName = Dir(FolderPath & "\*.txt")

Do While FileName <> ""
FileSpec = FolderPath & FileName
'Read all the file's text into a string variable.
Set TextFile = FSO.OpenTextFile(FileSpec, 1, False)
Text = TextFile.ReadAll
TextFile.Close

'Scan the string for words to replace and write the string back to the file.
Set TextFile = FSO.OpenTextFile(FileSpec, 2, False)
For I = 0 To UBound(SearchForWords)
Replace Text, SearchForWords(I), SubstituteWords(I)
Next I
TextFile.Write Text
TextFile.Close
FileName = Dir()
Loop

End Sub


Any help combining these two macros would be greatly appreciated. I am just trying to be able to replace all the special characters in a directory of text files.

note: the special character doesn't want to show on this post, but it is showing in my vba code as a square.

Thanks!

Kenneth Hobs
05-24-2016, 02:17 PM
Your characters are not known to the text file so it gets translated to what it can. VBA and the forum won't know what that special character is either. You can use chr() possibly.

Another approach might be to open the file into MSWord and use word's find/replace. Since office is a suite, that sort of makes sense. Similar character handling methods are needed even then though.

This may help a bit. Otherwise, attach your files so we can help more.

'http://www.vbaexpress.com/forum/showthread.php?p=250215
Sub Test_SearchReplaceInDoc()
SearchReplaceInDoc "x:\MSWord\SearchReplace\SearchReplaceInDoc.doc", "XXXXX", "123", True, False
End Sub

'http://www.vbaexpress.com/forum/showthread.php?t=38958
Sub SearchReplaceInDoc(doc As String, findString As String, replaceString As String, _
Optional docVisible As Boolean = True, _
Optional closeDoc As Boolean = True)

Dim wdApp As Object, WD As Object, rn As Long

rn = ActiveCell.Row
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then Set wdApp = CreateObject("Word.Application")
On Error GoTo 0

If Dir(doc) = "" Then Exit Sub
Set WD = wdApp.Documents.Open(doc)
wdApp.Visible = docVisible

With WD.Content.Find
.Text = findString '"XXXXX"
.Replacement.Text = replaceString '"123"
.Forward = True
.Wrap = 1
.Execute Replace:=2
End With

If closeDoc Then
Set WD = Nothing
Set wdApp = Nothing
End If
End Sub