Hi There,

I am using underneath sub to loop through files in a directory ...
I would like to run a macro on every workbook :"'Sige.xls'!Macro2"
And then save the changes on each workbook ...this last part does not
work ...
Anybody who can point me out?

Best Regards Sige

Sub LoopFiles()

Application.ScreenUpdating = False

Dim vFiles()
Dim vFileName As Variant
Dim i As Long
Dim myfile As String
Dim j As Long

MsgBox "At next dialog box, indicate at least one Excel " _
& "workbook file in the directory where all the files in " _
& "the same will be done."

vFileName = Application.GetSaveAsFilename(, "Excel files(*.XLS),
*.xls")

If vFileName = False Then Exit Sub

If MsgBox("All Excel workbook file (*.xls) in " _
& CurDir & " will be done now automatically. OK?", vbOKCancel)
_
= vbCancel Then Exit Sub

myfile = Dir("*.XLS") 'just one file

If myfile = "" Then
MsgBox "no files found"
Exit Sub
End If


Do While myfile < ""
i = i + 1
ReDim Preserve vFiles(1 To i)
vFiles(i) = myfile
myfile = Dir()
Loop

For i = LBound(vFiles) To UBound(vFiles)
Workbooks.Open FileName:=vFiles(i)
' Subroutine.
Application.Run "'Sige.xls'!Macro2"
Workbooks.Close FileName:=vFiles(i) True '<======

Next
MsgBox UBound(vFiles) - LBound(vFiles) + 1 & _
" workbook files were(was) done."

Application.ScreenUpdating = True
End Sub

Workbooks.Close FileName:=vFiles(i) True
would be
ActiveWorkbook.Close Savechanges:=True

or you could do it this way

Dim bk as Workbook
For i = LBound(vFiles) To UBound(vFiles)
set bk = Workbooks.Open( FileName:=vFiles(i))
' Subroutine.
Application.Run "'Sige.xls'!Macro2"
bk.close SaveChanges:=True
Next

--
Regards,
Tom Ogilvy

"Sige" wrote:

Hi There,

I am using underneath sub to loop through files in a directory ...
I would like to run a macro on every workbook :"'Sige.xls'!Macro2"
And then save the changes on each workbook ...this last part does not
work ...
Anybody who can point me out?

Best Regards Sige

Sub LoopFiles()

Application.ScreenUpdating = False

Dim vFiles()
Dim vFileName As Variant
Dim i As Long
Dim myfile As String
Dim j As Long

MsgBox "At next dialog box, indicate at least one Excel " _
& "workbook file in the directory where all the files in " _
& "the same will be done."

vFileName = Application.GetSaveAsFilename(, "Excel files(*.XLS),
*.xls")

If vFileName = False Then Exit Sub

If MsgBox("All Excel workbook file (*.xls) in " _
& CurDir & " will be done now automatically. OK?", vbOKCancel)
_
= vbCancel Then Exit Sub

myfile = Dir("*.XLS") 'just one file

If myfile = "" Then
MsgBox "no files found"
Exit Sub
End If


Do While myfile < ""
i = i + 1
ReDim Preserve vFiles(1 To i)
vFiles(i) = myfile
myfile = Dir()
Loop

For i = LBound(vFiles) To UBound(vFiles)
Workbooks.Open FileName:=vFiles(i)
' Subroutine.
Application.Run "'Sige.xls'!Macro2"
Workbooks.Close FileName:=vFiles(i) True '<======

Next
MsgBox UBound(vFiles) - LBound(vFiles) + 1 & _
" workbook files were(was) done."

Application.ScreenUpdating = True
End Sub

Thanks so much Tom!

Best Regards Sige

Is there an easy way,
to adjust above sub so that it works also on all files in the
subfolders ...??

Best Regards Sige

You could use application.filesearch:
Sub Tester2()
With Application.FileSearch
.NewSearch
.LookIn = "C:\My Documents"
.SearchSubFolders = True
.FileName = "*.xls"
' .MatchTextExactly = True
' .FileType = msoFileTypeAllFiles
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If


End With
End Sub

That is the easiest, but some claim they have problems with it.

Here is some that uses DIR as you are doing:

This is code that Bill Manville do some years ago. Seems to still work<g:

Option Base 1
Dim aFiles() As String, iFile As Integer


Sub ListAllFilesInDirectoryStructure()
Dim Counter As Integer
iFile = 0
ListFilesInDirectory "c:\test\" ' change the top level as you wish


For Counter = 1 To iFile
Worksheets("Sheet1").Cells(Counter, 1).Value = aFiles(Counter)
Next


End Sub


Sub ListFilesInDirectory(Directory As String)
Dim aDirs() As String, iDir As Integer, stFile As String


' use Dir function to find files and directories in Directory
' look for directories and build a separate array of them
' note that Dir returns files as well as directories when vbDirectory
specified
iDir = 0
stFile = Directory & Dir(Directory & "*.*", vbDirectory)
Do While stFile < Directory
If Right(stFile, 2) = "\." Or Right(stFile, 3) = "\.." Then
' do nothing - GetAttr doesn't like these directories
ElseIf GetAttr(stFile) = vbDirectory Then
' add to local array of directories
iDir = iDir + 1
ReDim Preserve aDirs(iDir)
aDirs(iDir) = stFile
Else
' add to global array of files
iFile = iFile + 1
ReDim Preserve aFiles(iFile)
aFiles(iFile) = stFile
End If
stFile = Directory & Dir()
Loop


' now, for any directories in aDirs call self recursively
If iDir 0 Then
For iDir = 1 To UBound(aDirs)
ListFilesInDirectory aDirs(iDir) & Application.PathSeparator
Next iDir
End If
End Sub

Other references:
http://support.microsoft.com/kb/185476/EN-US/
How To Search Directories to Find or List Files

http://support.microsoft.com/kb/185601/EN-US/
HOW TO: Recursively Search Directories by Using FileSystemObject

http://support.microsoft.com/kb/186118/EN-US/
How To Use FileSystemObject with Visual Basic

--
Regards,
Tom Ogilvy






"Sige" wrote:

Is there an easy way,
to adjust above sub so that it works also on all files in the
subfolders ...??

Best Regards Sige

Hi Tom,

Thanks. A more than complete answer!
I'll try to get 1 of them to work ;o)

I'll let you know my (final) result ...
Sige

Hi Tom,

I started with the easiest one first ... and it works more than fine!
That is the easiest, but some claim they have problems with it.
Luckily I am not among "some" this time...

One thing still though:
By activating the workbooks I think I loose a lot of "performance".
Is it possible to let my sub run without activating the workbooks
/"refreshing my screen"?

I thought the "Application.Screenupdating" would help me out here ...

Best Regards Sige


As promised my result:

Sub Tester2()
Dim i As Long
Dim myFirst As String
Dim FirstWb As Workbook
Dim vFileName As Variant
'*****
MsgBox "At next dialog box, indicate at least one Excel " _
& "workbook in the directory where all the files in " _
& "the same dir and all it's sub-dirs will be done."

vFileName = Application.GetSaveAsFilename(, "Excel files(*.XLS),
*.xls")
If vFileName = False Then Exit Sub
'*****
'myFirst = "*.xls"
Application.Screenupdating =False
With Application.FileSearch
.NewSearch
.LookIn = CurDir '"C:\"
.SearchSubFolders = True
' .FileName = myFirst
' .MatchTextExactly = False 'True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i)
Application.Run "'Sige.xls'!Macro2"
ActiveWorkbook.Close Savechanges:=True
Next i
Else
MsgBox "There were no files found."
End If
End With
Application.Screenupdating =True
End Sub



Sige wrote:
Hi Tom,

Thanks. A more than complete answer!
I'll try to get 1 of them to work ;o)

I'll let you know my (final) result ...
Sige