ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Run macro on multiple files (https://www.excelbanter.com/excel-programming/378320-run-macro-multiple-files.html)

diacci1st
Run macro on multiple files
 
Hi
At the moment i run the below:
I open a file with the GetOpenFilename command
then ran the code to make changes to the file
and i have a form where i Input the fine name as i want to save it and the
code saves the file to a location in my C drive.
I would like to know how I can do the above for multiple files so I could
open 3 files with the command ran the code in all 3 files and save it as
with 3 different names...
Can anyone help?
Thank you

Bob Phillips
Run macro on multiple files
 
GetOpenFilename only selects a file it doesn't open it.

It has a MultiSelect argument to cater for multiple selections.

And you didn't post the code.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"diacci1st" wrote in message
...
Hi
At the moment i run the below:
I open a file with the GetOpenFilename command
then ran the code to make changes to the file
and i have a form where i Input the fine name as i want to save it and the
code saves the file to a location in my C drive.
I would like to know how I can do the above for multiple files so I could
open 3 files with the command ran the code in all 3 files and save it as
with 3 different names...
Can anyone help?
Thank you

diacci1st
Run macro on multiple files
 
Hi Bob
Thank you for your reply...
this is the code that I use to do one file and I would like to be able to do
more than one file at one time as I need to do more than 90 on a Month!!
On the code you ll see a reference to a form called ABB and a text box
called TEXT
can you please help?
Sub aabb()
ABB.Show
Dim FName As Variant
FName = Application.GetOpenFilename("Text files (*.txt),*.txt")
Open FName For Input As #1
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, textline ' Get one line
ActiveCell.Value = textline
Call function_assess
ActiveCell.Offset(1, 0).Select
Loop
Close #1
ActiveCell.Value = "end"
Range("A1").Select

Call aabb_readtotext_a

Columns("A").Select

Worksheets("Sheet1").Columns("A").Clear

Range("A1").Select

End Sub

Sub aabb_readtotext_a()
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\ABB\" & ABB.text & ".txt", True)
Do While ActiveCell.Value < "end"
s = ActiveCell.Value
a.WriteLine (s)
ActiveCell.Offset(1, 0).Select
Loop
a.Close

End Sub
Sub function_assess()
textline = ActiveCell.Value
If Left(textline, 1) = "1" Then
textline = Application.WorksheetFunction.Replace _
(textline, 94, 19, String(19, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 113, 40, String(40, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 183, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 208, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 228, 30, String(30, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 258, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 278, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 298, 30, String(30, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 328, 15, String(15, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 523, 13, String(13, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 632, 50, String(50, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 702, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 947, 45, String(45, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 992, 45, String(45, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 1037, 45, String(45, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 1082, 45, String(45, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 1127, 45, String(45, "*"))

ActiveCell.Value = textline
End If

If Left(textline, 1) = "2" Then
textline = Application.WorksheetFunction.Replace _
(textline, 61, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 81, 30, String(30, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 111, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 131, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 151, 30, String(30, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 189, 20, String(20, "*"))

ActiveCell.Value = textline
End If
End Sub




"Bob Phillips" wrote:

GetOpenFilename only selects a file it doesn't open it.

It has a MultiSelect argument to cater for multiple selections.

And you didn't post the code.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"diacci1st" wrote in message
...
Hi
At the moment i run the below:
I open a file with the GetOpenFilename command
then ran the code to make changes to the file
and i have a form where i Input the fine name as i want to save it and the
code saves the file to a location in my C drive.
I would like to know how I can do the above for multiple files so I could
open 3 files with the command ran the code in all 3 files and save it as
with 3 different names...
Can anyone help?
Thank you

Bob Phillips
Run macro on multiple files
 
Try this

Sub aabb()
Dim FName As Variant

ABB.Show
FName = Application.GetOpenFilename(FileFilter:="Text files
(*.txt),*.txt", _
MultiSelect:=True)
For i = LBound(FName) To UBound(FName)
Open FName(i) For Input As #1
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, textline ' Get one line
ActiveCell.Value = textline
Call function_assess
ActiveCell.Offset(1, 0).Select
Loop
Close #1
Next i
ActiveCell.Value = "end"
Range("A1").Select

Call aabb_readtotext_a

Columns("A").Select

Worksheets("Sheet1").Columns("A").Clear

Range("A1").Select

End Sub


--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"diacci1st" wrote in message
...
Hi Bob
Thank you for your reply...
this is the code that I use to do one file and I would like to be able to
do
more than one file at one time as I need to do more than 90 on a Month!!
On the code you ll see a reference to a form called ABB and a text box
called TEXT
can you please help?
Sub aabb()
ABB.Show
Dim FName As Variant
FName = Application.GetOpenFilename("Text files (*.txt),*.txt")
Open FName For Input As #1
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, textline ' Get one line
ActiveCell.Value = textline
Call function_assess
ActiveCell.Offset(1, 0).Select
Loop
Close #1
ActiveCell.Value = "end"
Range("A1").Select

Call aabb_readtotext_a

Columns("A").Select

Worksheets("Sheet1").Columns("A").Clear

Range("A1").Select

End Sub

Sub aabb_readtotext_a()
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\ABB\" & ABB.text & ".txt", True)
Do While ActiveCell.Value < "end"
s = ActiveCell.Value
a.WriteLine (s)
ActiveCell.Offset(1, 0).Select
Loop
a.Close

End Sub
Sub function_assess()
textline = ActiveCell.Value
If Left(textline, 1) = "1" Then
textline = Application.WorksheetFunction.Replace _
(textline, 94, 19, String(19, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 113, 40, String(40, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 183, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 208, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 228, 30, String(30, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 258, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 278, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 298, 30, String(30, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 328, 15, String(15, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 523, 13, String(13, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 632, 50, String(50, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 702, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 947, 45, String(45, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 992, 45, String(45, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 1037, 45, String(45, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 1082, 45, String(45, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 1127, 45, String(45, "*"))

ActiveCell.Value = textline
End If

If Left(textline, 1) = "2" Then
textline = Application.WorksheetFunction.Replace _
(textline, 61, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 81, 30, String(30, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 111, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 131, 20, String(20, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 151, 30, String(30, "*"))

textline = Application.WorksheetFunction.Replace _
(textline, 189, 20, String(20, "*"))

ActiveCell.Value = textline
End If
End Sub




"Bob Phillips" wrote:

GetOpenFilename only selects a file it doesn't open it.

It has a MultiSelect argument to cater for multiple selections.

And you didn't post the code.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"diacci1st" wrote in message
...
Hi
At the moment i run the below:
I open a file with the GetOpenFilename command
then ran the code to make changes to the file
and i have a form where i Input the fine name as i want to save it and
the
code saves the file to a location in my C drive.
I would like to know how I can do the above for multiple files so I
could
open 3 files with the command ran the code in all 3 files and save it
as
with 3 different names...
Can anyone help?
Thank you


All times are GMT +1. The time now is 01:27 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com