mpa15
06-22-2011, 11:30 PM
Hi All,
I'm trying to write a macro that will take a function as an argument (see code below). Everything seems to be working except the function that gets called is applied to the macro-containing file and not the files it loops through. Any help would be greatly appreciated. Thanks in advance.
Regards,
Maksim
Function MacroF()
Range("A1:A20").Select
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
End Function
Function MacroG()
Range("A1:A20").Select
Selection.Copy
Range("G1").Select
ActiveSheet.Paste
End Function
Function MacroH()
Range("A1:A20").Select
Selection.Copy
Range("H1").Select
ActiveSheet.Paste
End Function
Function FolderDialog()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a directory"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancelled"
Else
FolderDialog = .SelectedItems(1)
End If
End With
End Function
Sub File_Search(CodeToRun)
Dim Coll_Docs As New Collection
Dim Search_path, Search_Filter, Search_Fullname As String
Dim DocName As String
Dim wbk As Workbook
Dim i As Long
Search_path = FolderDialog() ' where ?
Search_Filter = "*." & InputBox("Enter the filetype to look for (e.g. xls)", "Identify File Type", "xls") ' what ?
Set Coll_Docs = Nothing
DocName = Dir(Search_path & "\" & Search_Filter)
Do Until DocName = "" ' build the collection
Coll_Docs.Add Item:=DocName
DocName = Dir
Loop
MsgBox "There were " & Coll_Docs.Count & " file(s) found."
For i = Coll_Docs.Count To 1 Step -1 '
Search_Fullname = Search_path & "\" & Coll_Docs(i)
Set wbk = Workbooks.Open(Search_path & "\" & Coll_Docs(i))
'(your code here)
wbk.Activate
With wbk.ActiveSheet
Application.Run (CodeToRun)
wbk.Close SaveChanges:=True
End With
Next
End Sub
Sub TestFSM()
Call File_Search(MacroF)
End Sub
I'm trying to write a macro that will take a function as an argument (see code below). Everything seems to be working except the function that gets called is applied to the macro-containing file and not the files it loops through. Any help would be greatly appreciated. Thanks in advance.
Regards,
Maksim
Function MacroF()
Range("A1:A20").Select
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
End Function
Function MacroG()
Range("A1:A20").Select
Selection.Copy
Range("G1").Select
ActiveSheet.Paste
End Function
Function MacroH()
Range("A1:A20").Select
Selection.Copy
Range("H1").Select
ActiveSheet.Paste
End Function
Function FolderDialog()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a directory"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancelled"
Else
FolderDialog = .SelectedItems(1)
End If
End With
End Function
Sub File_Search(CodeToRun)
Dim Coll_Docs As New Collection
Dim Search_path, Search_Filter, Search_Fullname As String
Dim DocName As String
Dim wbk As Workbook
Dim i As Long
Search_path = FolderDialog() ' where ?
Search_Filter = "*." & InputBox("Enter the filetype to look for (e.g. xls)", "Identify File Type", "xls") ' what ?
Set Coll_Docs = Nothing
DocName = Dir(Search_path & "\" & Search_Filter)
Do Until DocName = "" ' build the collection
Coll_Docs.Add Item:=DocName
DocName = Dir
Loop
MsgBox "There were " & Coll_Docs.Count & " file(s) found."
For i = Coll_Docs.Count To 1 Step -1 '
Search_Fullname = Search_path & "\" & Coll_Docs(i)
Set wbk = Workbooks.Open(Search_path & "\" & Coll_Docs(i))
'(your code here)
wbk.Activate
With wbk.ActiveSheet
Application.Run (CodeToRun)
wbk.Close SaveChanges:=True
End With
Next
End Sub
Sub TestFSM()
Call File_Search(MacroF)
End Sub