Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Run Macro on multiple files | Excel Discussion (Misc queries) | |||
Macro: Filter Multiple header then extract to Multiple Files | Excel Discussion (Misc queries) | |||
Modify macro code to export multiple cell contents to multiple Text Files | Excel Programming | |||
Opening multiple .xls files with a macro | Excel Programming | |||
Import multiple files macro can't find files | Excel Programming |