Text replacement with VBA Excel in several files

  • Thread starter Thread starter pieros
  • Start date Start date
P

pieros

Good morning,
I've got a folder with many subfolders in it filled with several text
files. Some of these text files have a filename with "KART" in it.
In these files (with "KART" in their filenames) I have to replace the
text "503" in "305".
Can anyone please help met with VBA code?

Many Thanks.
 
Hi pieros,

Try this replacing "C:\Temp\" with the path where you have the files::

Sub RenameFiles()
Set fs = Application.FileSearch
With fs
.LookIn = "C:\Temp\"
.SearchSubFolders = False
.Filename = "*KART*"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) Like "*503*" Then _
FileCopy .FoundFiles(i), Replace(.FoundFiles(i), "503",
"305")
Next i
End If
End With
End Sub

Regards,
KL
 
Sub SubGetMyData()

Dim objFSO As Object
Dim objFolder As Object
Dim objSubfolder As Object
Dim objFile As Object
Dim iRow As Long

iRow = 3
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\MyTest\")
For Each objFile In objFolder.Files
If objFile.Type = "Text Document" Then
Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name
With ActiveSheet
.Cells.Replace What:="503", Replacement:="305"
End With
ActiveWorkbook.Close savechanges:=True
End If
Next
End Sub
 
Thanks KL. It works .. once.
I'm sorry but I wanted to change the text again and this did not work.
Nothing happens.

In the files is the text at the moment "503"
The code I use is:

Option Explicit

Dim fs As Variant, i As Integer

Sub RenameFiles()
Set fs = Application.FileSearch
With fs
.LookIn = "C:\Documents and Settings\meidamp\Desktop\Temp\TEST
TemplateOntw"
.SearchSubFolders = False
.Filename = "*KART*"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) Like "*503*" Then _
FileCopy .FoundFiles(i), Replace(.FoundFiles(i), "503",
"530")
Next i
End If
End With
End Sub

Did I something wrong with the code?

Pieros.
 
Bob, is it possible that this code is a VB-code and not a VBA code?
When I run this macro in Excel I get the following message: 'Run-time
error 429, ActiveX component can't create object' at line 'Set objFSO'.
Can you help me with this?

Greetings,
Pieros
 
This would be true if the scripting runtime is not installed on your
machine. In the VBE in Tools=>References, do you see Microsoft Scripting
Runtime in the list (scrrun.dll, usually in teh windows system directory).
If not, then you either have to install it or you can't use these commands.
 
Hello KL, I've now tried your code again but i made a mistake with my
earlier conclusion; I thought the code was working well but the line
with "FileCopy .FoundFiles(i), Replace(.FoundFiles(i), "503", "999")"
seems not to work. The files are not changed at all.
Is there another way maybe to replace the text?
By the way I do not get an error, it seems that the replacing goes
well.
(Please don't look at my English because I come from Holland).
When I place a msgbox to look how many files the program finds the
msgbox gives the right number of files with "KART".

Greetings,
Pieros
 
Hi pieros,

Curiously the code doesn't work with .Filename = "*KART*", but it does with
..Filename = "*KART*.txt" :-0

Regards,
KL

Sub RenameFiles()
Dim fs As FileSearch, i As Long
Set fs = Application.FileSearch
With fs
.LookIn = "C:\Temp\"
.SearchSubFolders = False
.Filename = "*KART*.txt"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) Like "*503*" Then _
FileCopy .FoundFiles(i), _
Replace(.FoundFiles(i), "503", "305")
Kill .FoundFiles(i)
Next i
End If
End With
End Sub
 
Hi KL,

I've tried again and now with "*KART*.txt". When I start the macro I
can see that theprogram is working for several seconds and then it
stops. But when I look in the files no text has changed.
I have seen .SearchSubFolders = False in the code. The files I am
looking in are located in subfolders. I did change False in True and
ran the code but evenso nothing did change in the text file.
It seems to be not so easy to change text in multiple files?
Maybe you can help me further, if not many thanks sofar!!

Pieros
 
can you give me a few examples of file names you are trying to modify and
their complete paths?

Thanks,
KL
 
Here is an example of the path: "C:\Documents and
Settings\Desktop\Temp\TEST TemplateOntw"
In this folder there are several subfolders named: "Cop00005000" ,
"Cop00013000" and more.
In these subfolders are the files located with the text to be replaced;
some filenames are "00005008_001_KART_V1.fmt",
"00005008_001_KART_V2.fmt", "00005194_001_ACET_V1.fmt" and so on.
The text to be replaced is located in only the "KART" files.

Gr.,
Pieros
 
Hi pieros,

Sorry I misunderstood your original posting - I thought you were trying to
rename your files (change 503 to 305 within the file names) which can be
fixed by changing .Filename = "*KART*" to .Filename = "*KART*.fmt"

However, I now realize that you actually want to make changes to the
contents of the files, so you could try the code below.

Regards,
KL


Sub UpdateFiles()
Dim fs As FileSearch, i As Long
Dim x As Integer, nRec As Long
Dim txt As String * 3, n As Long

Set fs = Application.FileSearch
With fs
.LookIn = "C:\Documents and Settings\Desktop\Temp\TEST
TemplateOntw\"
.SearchSubFolders = True
.Filename = "*KART*.fmt"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
x = FreeFile(0)
Open .FoundFiles(i) For Random As x Len = 3
For nRec = 1 To LOF(x)
Get x, nRec, txt
If txt = "503" Then
LSet txt = "305"
Put x, nRec, txt
End If
Next nRec
Close x
Next i
End If
End With
End Sub
 
Hello KL,
I've tested this code with the F8-function key and now I have seen that
the lines 'LSet txt = "305"' and the next line are being jumped over.
The program jumps to the line 'End If' and again to 'Next nRec'. There
did nothing change in the files.
I'v here an example from a piece of text from my text file:

Width = 52;
Height = 52;
Cut = Off;
Thickness = 1.70;

YOffset =10;
MaxHeight = 503;

Shift(1,-1)

The meaning is to change the text 503 (in all files with filenames
containing KART) in the text 305.

Regards,
Pieros
 
Hi pieros,

Try this slightly modified codo published by Dave Peterson some time ago:

Regards,
KL

Option Explicit

Sub UpdateFiles()
Dim IFileNum As Long
Dim OFileNum As Long
Dim WholeLine As String
Dim i As Long

Dim myOutputFolder As String
myOutputFolder = "C:\Documents and Settings\Desktop\Temp\New\"

On Error Resume Next
MkDir myOutputFolder
On Error GoTo 0

With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\Desktop\Temp\TEST
TemplateOntw\"
.SearchSubFolders = True
.Filename = "*KART*.fmt"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
IFileNum = FreeFile

Close #IFileNum
Open .FoundFiles(i) For Input As #IFileNum

OFileNum = FreeFile
Close #OFileNum

Open myOutputFolder & Dir(.FoundFiles(i)) _
For Output As #OFileNum

While Not EOF(IFileNum)
Line Input #IFileNum, WholeLine
If Len(Trim(WholeLine)) > 0 Then _
WholeLine = Replace(WholeLine, "503", "305")
Print #OFileNum, WholeLine
Wend
Close #IFileNum
Close #OFileNum
Next i
End If
End With
End Sub
 
KL many thanks it seems to work!!
I've tried the code again with F8 key and now I see modified files in
the folder TEST. The text 503 did change in 305.
I am very pleased and I can now go on with it.
Again; Many thanks!!
(If you don't mind I maybe later have some more questions about this
item?)

(I live in The Netherlands, are you from the US? I ask you because I
did see the time of one of your answers; 29 jun 01:13. At that time I
am already sleeping).

Regards,
Pieros
 
Hi pieros,

"pieros wrote
(If you don't mind I maybe later have some more questions about this
item?)
Click to expand...

I don't, but I think you will be much better off posting your questions to
the attention of the whole group.
(I live in The Netherlands, are you from the US? I ask you because I
did see the time of one of your answers; 29 jun 01:13. At that time I
am already sleeping).
Click to expand...

I live in Spain so I am also supposed to be sleeping at that time, but...

Regards,
KL
 
Hallo KL,

The next question I post to the attention of the whole group!
Sometimes I've also problems to stop with computering at the end of the
evening, because it is too exciting at that moment.

Kindly Regards,
Pieter.
 
Back
Top