Do same thing to each workbook found in a folder
Hi,
I'd like to open each workbook in a folder, make a certain change, save the file, close it, and go to the next... Help?! |
Do same thing to each workbook found in a folder
Sub ProcessFiles()Dim sFolder As String
Dim FSO As Object Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Dim oWb As Workbook Set FSO = CreateObject("Scripting.FileSystemObject") sFolder = "C:\myTest" If sFolder < "" Then Set Folder = FSO.GetFolder(sFolder) Set Files = Folder.Files For Each file In Files If file.Type = "Microsoft Excel Worksheet" Then Set oWb = Workbooks.Open FileName:=file.Path KennysMacro End If Next file End If ' sFolder < "" End Sub -- HTH RP "KENNY" wrote in message ... Hi, I'd like to open each workbook in a folder, make a certain change, save the file, close it, and go to the next... Help?! |
Do same thing to each workbook found in a folder
Thanks for the response: I've tried to shoehorn your code
to my sample macro, but have two problems (the rows with ***). Could you have a look? Thanks! Sub CULL() ' CULL Macro ' Macro recorded 10/7/2004 by dykoffp Dim FSO As Object Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Dim oWb As Workbook Set FSO = CreateObject("Scripting.FileSystemObject") sFolder = "Y:\Sales\2005 Sales Forecast Workbooks\2005 Sales Forecast - Working Files" If sFolder < "" Then Set Folder = FSO.GetFolder(sFolder) Set Files = Folder.Files For Each file In Files If file.Type = "Microsoft Excel Worksheet" Then *** Set oWb = Workbooks.Open FileName:=file.Path Range("H7").Select Selection.Copy Range("I7").Select Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("H15").Select ActiveWorkbook.Save ActiveWorkbook.Close End If Next file *** End If sFolder < "" -----Original Message----- Sub ProcessFiles()Dim sFolder As String Dim FSO As Object Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Dim oWb As Workbook Set FSO = CreateObject("Scripting.FileSystemObject") sFolder = "C:\myTest" If sFolder < "" Then Set Folder = FSO.GetFolder(sFolder) Set Files = Folder.Files For Each file In Files If file.Type = "Microsoft Excel Worksheet" Then Set oWb = Workbooks.Open FileName:=file.Path KennysMacro End If Next file End If ' sFolder < "" End Sub -- HTH RP "KENNY" wrote in message ... Hi, I'd like to open each workbook in a folder, make a certain change, save the file, close it, and go to the next... Help?! . |
Do same thing to each workbook found in a folder
My fault for trying to adjust some other code.
Try this (watch the wrap-around) Sub CULL() ' CULL Macro ' Macro recorded 10/7/2004 by dykoffp Dim FSO As Object Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Dim oWb As Workbook Dim sFolder As String Set FSO = CreateObject("Scripting.FileSystemObject") sFolder = "Y:\Sales\2005 Sales Forecast Workbooks\2005 Sales Forecast - Working Files" If sFolder < "" Then Set Folder = FSO.GetFolder(sFolder) Set Files = Folder.Files For Each file In Files If file.Type = "Microsoft Excel Worksheet" Then Set oWb = Workbooks.Open(Filename:=file.Path) Range("H7").Select Selection.Copy Range("I7").Select Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("H15").Select ActiveWorkbook.Save ActiveWorkbook.Close End If Next file End If End Sub -- HTH RP "KENNY" wrote in message ... Thanks for the response: I've tried to shoehorn your code to my sample macro, but have two problems (the rows with ***). Could you have a look? Thanks! Sub CULL() ' CULL Macro ' Macro recorded 10/7/2004 by dykoffp Dim FSO As Object Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Dim oWb As Workbook Set FSO = CreateObject("Scripting.FileSystemObject") sFolder = "Y:\Sales\2005 Sales Forecast Workbooks\2005 Sales Forecast - Working Files" If sFolder < "" Then Set Folder = FSO.GetFolder(sFolder) Set Files = Folder.Files For Each file In Files If file.Type = "Microsoft Excel Worksheet" Then *** Set oWb = Workbooks.Open FileName:=file.Path Range("H7").Select Selection.Copy Range("I7").Select Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("H15").Select ActiveWorkbook.Save ActiveWorkbook.Close End If Next file *** End If sFolder < "" -----Original Message----- Sub ProcessFiles()Dim sFolder As String Dim FSO As Object Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Dim oWb As Workbook Set FSO = CreateObject("Scripting.FileSystemObject") sFolder = "C:\myTest" If sFolder < "" Then Set Folder = FSO.GetFolder(sFolder) Set Files = Folder.Files For Each file In Files If file.Type = "Microsoft Excel Worksheet" Then Set oWb = Workbooks.Open FileName:=file.Path KennysMacro End If Next file End If ' sFolder < "" End Sub -- HTH RP "KENNY" wrote in message ... Hi, I'd like to open each workbook in a folder, make a certain change, save the file, close it, and go to the next... Help?! . |
Do same thing to each workbook found in a folder
Success! Thank you VERY much
-----Original Message----- My fault for trying to adjust some other code. Try this (watch the wrap-around) Sub CULL() ' CULL Macro ' Macro recorded 10/7/2004 by dykoffp Dim FSO As Object Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Dim oWb As Workbook Dim sFolder As String Set FSO = CreateObject("Scripting.FileSystemObject") sFolder = "Y:\Sales\2005 Sales Forecast Workbooks\2005 Sales Forecast - Working Files" If sFolder < "" Then Set Folder = FSO.GetFolder(sFolder) Set Files = Folder.Files For Each file In Files If file.Type = "Microsoft Excel Worksheet" Then Set oWb = Workbooks.Open (Filename:=file.Path) Range("H7").Select Selection.Copy Range("I7").Select Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("H15").Select ActiveWorkbook.Save ActiveWorkbook.Close End If Next file End If End Sub -- HTH RP "KENNY" wrote in message ... Thanks for the response: I've tried to shoehorn your code to my sample macro, but have two problems (the rows with ***). Could you have a look? Thanks! Sub CULL() ' CULL Macro ' Macro recorded 10/7/2004 by dykoffp Dim FSO As Object Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Dim oWb As Workbook Set FSO = CreateObject("Scripting.FileSystemObject") sFolder = "Y:\Sales\2005 Sales Forecast Workbooks\2005 Sales Forecast - Working Files" If sFolder < "" Then Set Folder = FSO.GetFolder(sFolder) Set Files = Folder.Files For Each file In Files If file.Type = "Microsoft Excel Worksheet" Then *** Set oWb = Workbooks.Open FileName:=file.Path Range("H7").Select Selection.Copy Range("I7").Select Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("H15").Select ActiveWorkbook.Save ActiveWorkbook.Close End If Next file *** End If sFolder < "" -----Original Message----- Sub ProcessFiles()Dim sFolder As String Dim FSO As Object Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Dim oWb As Workbook Set FSO = CreateObject ("Scripting.FileSystemObject") sFolder = "C:\myTest" If sFolder < "" Then Set Folder = FSO.GetFolder(sFolder) Set Files = Folder.Files For Each file In Files If file.Type = "Microsoft Excel Worksheet" Then Set oWb = Workbooks.Open FileName:=file.Path KennysMacro End If Next file End If ' sFolder < "" End Sub -- HTH RP "KENNY" wrote in message ... Hi, I'd like to open each workbook in a folder, make a certain change, save the file, close it, and go to the next... Help?! . . |
All times are GMT +1. The time now is 06:27 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com