ActiveWorkbook.Close True

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Sige - 21 Mar 2006 13:33 GMT

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

Reply to this Message

Tom Ogilvy - 21 Mar 2006 14:40 GMT

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

Signature

Regards,
Tom Ogilvy

> Hi There,
>
[quoted text clipped - 56 lines]
> Application.ScreenUpdating = True
> End Sub

Reply to this Message

Sige - 21 Mar 2006 15:15 GMT

Thanks so much Tom!

Best Regards Sige

Reply to this Message

Sige - 21 Mar 2006 15:47 GMT

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

Best Regards Sige

Reply to this Message

Tom Ogilvy - 21 Mar 2006 16:13 GMT

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

Signature

Regards,
Tom Ogilvy

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

Reply to this Message

Sige - 21 Mar 2006 16:38 GMT

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

Reply to this Message

Sige - 22 Mar 2006 09:59 GMT

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

> Hi Tom,
>
[quoted text clipped - 3 lines]
> I'll let you know my (final) result ...
> Sige

Reply to this Message