Pause a loop after 100 cycles

[Dallas]

I have a macro that cycles through each file in a folder and makes some
changes, prints, saves and then closes one at a time. Some of the folders I
need to run this code on have a very large number of files in them and the
printer will with out a doubt run out of paper before the folder is finished.
I would like to have the macro pause after 100 cycles so I can check the
printer for paper and click OK on a message box to continue. Here is the code
I am currently using. I would also like have the macro promt to select the
right folder with a browser box rather than an input box. I tried using
msoFileDialogFolderPicker without much success.

Thanks,
Dallas

Sub FixQIshtsInFolder()
Dim myPath As String
myPath = InputBox("Path?")
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(myPath)
Set fc = f.Files
For Each f1 In fc
If LCase(Right(Trim(f1.Name), 4)) = ".xls" Then
Workbooks.Open myPath & "\" & f1.Name
Application.Run "QIshtNoMsg" 'do whatever
End If
Next
MsgBox "Folder Done!"
End Sub

 

[Mike]

Try this
Sub FixQIshtsInFolder()
Dim myPath As String
myPath = InputBox("Path?")
Dim fs, f, f1, fc
Dim iCounter As Long
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(myPath)
Set fc = f.Files
iCounter = 0
For Each f1 In fc
If iCounter < 99 Then
MsgBox "Check printer for paper.", vbQuestion
iCounter = 0
End If
If LCase(Right(Trim(f1.Name), 4)) = ".xls" Then
Workbooks.Open myPath & "\" & f1.Name
Application.Run "QIshtNoMsg" 'do whatever
End If
iCounter = iCounter = 1
Next
MsgBox "Folder Done!"
End Sub

 

[Mike]

Change iCounter < 99
to iCounter = 100

 

[FSt1]

hi
you could add a counter with msgbox.
Sub FixQIshtsInFolder()
Dim myPath As String
dim c as long 'counter
c= 0 'setup
myPath = InputBox("Path?")
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(myPath)
Set fc = f.Files
For Each f1 In fc
If LCase(Right(Trim(f1.Name), 4)) = ".xls" Then
Workbooks.Open myPath & "\" & f1.Name
Application.Run "QIshtNoMsg" 'do whatever
End If
c= c+1 'counting
if c = 100 then 'checking the counting
msgbox "go check the printer" 'AHA!
end if
Next
MsgBox "Folder Done!"
End Sub

regards
FSt1

 

[FSt1]

Opps. forgot to set the counter back to zero.
if c = 100 then 'checking the counting
msgbox "go check the printer" 'AHA!> end if
c=0
end if

sorry.
regards
FSt1

 

[Dallas]

Thanks mike for your reply. the first bit of code you sent worked except it
put prompted the message box after every file and when I changed the < to =
it wouldn't prompt at all. Not sure why that didn't work. I did change it
from 100 to 5 just for testing purposes. FSt1's suggestion worked great
though. Thanks for your input.

 

[Dallas]

Perfect, works great. After I tested it I added an Input Box for the number
of files to cycle and it works great. Here is the code for the sake of the
thread.

Thanks alot!
Dallas

Sub FixQIshtsInFolder2()
Dim myPath As String
Dim c As Long 'counter
Dim n As Long
c = 0 'setup
myPath = InputBox("Path?")
n = InputBox("Number of files to cycle between printer checks.")
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(myPath)
Set fc = f.Files
For Each f1 In fc
If LCase(Right(Trim(f1.Name), 4)) = ".xls" Then
Workbooks.Open myPath & "\" & f1.Name
Application.Run "QIshtNoMsg" 'do whatever
End If
c = c + 1 'counting
If c = n Then 'checking the counting
MsgBox "go check the printer for paper" 'AHA!
c = 0
End If
Next
MsgBox "Folder Done!"
End Sub

 

[FSt1]

glad to help,
regards
FSt1

Perfect, works great. After I tested it I added an Input Box for the number
of files to cycle and it works great. Here is the code for the sake of the
thread.

Thanks alot!
Dallas

Sub FixQIshtsInFolder2()
Dim myPath As String
Dim c As Long 'counter
Dim n As Long
c = 0 'setup
myPath = InputBox("Path?")
n = InputBox("Number of files to cycle between printer checks.")
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(myPath)
Set fc = f.Files
For Each f1 In fc
If LCase(Right(Trim(f1.Name), 4)) = ".xls" Then
Workbooks.Open myPath & "\" & f1.Name
Application.Run "QIshtNoMsg" 'do whatever
End If
c = c + 1 'counting
If c = n Then 'checking the counting
MsgBox "go check the printer for paper" 'AHA!
c = 0
End If
Next
MsgBox "Folder Done!"
End Sub