[jlawson]

I work for a non-profit hospital and I've developed a MS Word form for
the nurses to use for notifying the Scheduling department when the
scheduling department is closed. All the forms are saved to a certain
folder Scheduling can get to.

What I wanted to make was a separate document for the Manager for that
department to print all the forms in that folder by a date range.
I've found a macro on a help site (I don't remember the name) that
will allow the manager to print all the documents in a folder and
modified it.

The format the form saves in is: MM-DD-YYYY Doe,John 99999 the 99999 is
a unique identifier for that particular patient visit. I can create a
Userform for the manager where she can type in the date range she
wants. I was thinking of using the date form saved in the folder which
is the date modified.

This is the macro, so far, for printing everything in the folder:

Private Sub BatchFilePrint_Click()
Dim fs, f, fc, f1
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("S:\After Hours Scheduling\Requests")
Set fc = f.Files
Dim FileList() As String
Dim Cnt As Integer
Cnt = 0
Dim myDoc As Word.Document

For Each f1 In fc
Dim WithoutExt As String
WithoutExt = LCase(Right(f1.Name, 4))
Dim FileName As String
FileName = Left(f1.Name, Len(f1.Name) - 4)
If WithoutExt = LCase(".doc") Then
WordBasic.DisableAutoMacros 1
Application.Documents.Open FileName:=f & "\" & f1.Name,
Visible:=False
Set myDoc = Application.Documents(f & "\" & f1.Name)
myDoc.PrintOut
myDoc.Close savechanges:=False
Set myDoc = Nothing
WithoutExt = ""
FileName = ""
WordBasic.DisableAutoMacros 0
End If
Next
End Sub


We are using MS Office XP here. Thank you in advance!

[Ed]

Hi jlawson,

The following code may be of some use. The code assumes that the dates
entered by the manager are entered into textboxes called txtStartDate and
txtEndDate and that the format of the dates entered is "MM-DD-YYYY".

The macro uses the FileSystemObject to get the date the files were last
modified and converts these dates and the dates entered by the manager to
"YYYYMMDD" format which makes the dates easy to compare.

If you don't want to use the actual last modified dates of the files you
could modify the code to get the dates from the filenames in the same way
that StartDate and EndDate are handled.

The code perfoms a "For Each" loop twice: the first pass is just to count
the files so that the manager can be warned if he or she has accidentally
specified dates that would result in a huge number of files being selected.

Hope I haven't left too many bugs in the code :-)

Cheers.

Ed

Private Sub BatchFilePrint_Click()
Dim oFSO As Scripting.FileSystemObject
Dim oFolder As Folder
Dim oFile As File
Dim oDoc As Word.Document
Dim Extension As String
Dim StartDate As String
Dim EndDate As String
Dim FileModifiedDate As String
Dim Msg As String
Dim NumFilesToPrint As Integer
Dim Response As VbMsgBoxResult

Const FolderPath As String = "S:\After Hours Scheduling\Requests"
Const AppTitle As String = "Schedules Print"
Const MaxFilesToPrint As Integer = 10

On Error GoTo ErrHandler

If Not DateOK(txtStartDate.Text) Then
MsgBox "Invalid start date", vbExclamation, AppTitle
Exit Sub
End If

If Not DateOK(txtEndDate.Text) Then
MsgBox "Invalid end date", vbExclamation, AppTitle
Exit Sub
End If

StartDate = Right(txtStartDate.Text, 4) & Left(txtStartDate.Text, 2) &
Mid(txtStartDate.Text, 4, 2)
EndDate = Right(txtEndDate.Text, 4) & Left(txtEndDate.Text, 2) &
Mid(txtEndDate.Text, 4, 2)

If StartDate EndDate Then
MsgBox "The start date is later than the end date", vbExclamation,
AppTitle
Exit Sub
End If

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(FolderPath)

For Each oFile In oFolder.Files
Extension = LCase(Right(oFile.Name, 4))
If Extension = ".doc" And Left(oFile.Name, 1) "~" Then
FileModifiedDate = Format(oFile.DateLastModified, "yyyymmdd")
If FileModifiedDate = StartDate And FileModifiedDate = EndDate Then
NumFilesToPrint = NumFilesToPrint + 1
End If
End If
Next

If NumFilesToPrint MaxFilesToPrint Then
Msg = "Are you sure you want to print " & NumFilesToPrint & " files?"
Response = MsgBox(Msg, vbQuestion + vbYesNo, AppTitle)
If Response = vbNo Then
Exit Sub
End If
End If

WordBasic.DisableAutoMacros 1

For Each oFile In oFolder.Files
Extension = LCase(Right(oFile.Name, 4))
If Extension = ".doc" And Left(oFile.Name, 1) "~" Then
FileModifiedDate = Format(oFile.DateLastModified, "yyyymmdd")
If FileModifiedDate = StartDate And FileModifiedDate = EndDate Then
Set oDoc = Documents.Open(FileName:=oFile.Path, Visible:=True)
oDoc.PrintOut
oDoc.Close savechanges:=wdDoNotSaveChanges
End If
End If
Next

WordBasic.DisableAutoMacros 0

ExitPoint:
'Put any cleanup code here
Exit Sub

ErrHandler:
Msg = "An error has occurred. Please contact JLawson." & vbCrLf & vbCrLf
& _
"Error " & Err.Number & " - " & Err.Description
MsgBox Msg, vbCritical, AppTitle

Resume ExitPoint
End Sub

Private Function DateOK(DateToCheck As String) As Boolean
'basic checks - could be beefed up

If (Not IsDate(DateToCheck)) _
Or Len(DateToCheck) 10 _
Or Mid(DateToCheck, 3, 1) "-" _
Or Mid(DateToCheck, 6, 1) "-" Then
DateOK = False
Exit Function
Else
DateOK = True
End If
End Function

"jlawson" wrote:

I work for a non-profit hospital and I've developed a MS Word form for
the nurses to use for notifying the Scheduling department when the
scheduling department is closed. All the forms are saved to a certain
folder Scheduling can get to.

What I wanted to make was a separate document for the Manager for that
department to print all the forms in that folder by a date range.
I've found a macro on a help site (I don't remember the name) that
will allow the manager to print all the documents in a folder and
modified it.

The format the form saves in is: MM-DD-YYYY Doe,John 99999 the 99999 is
a unique identifier for that particular patient visit. I can create a
Userform for the manager where she can type in the date range she
wants. I was thinking of using the date form saved in the folder which
is the date modified.

This is the macro, so far, for printing everything in the folder:

Private Sub BatchFilePrint_Click()
Dim fs, f, fc, f1
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("S:\After Hours Scheduling\Requests")
Set fc = f.Files
Dim FileList() As String
Dim Cnt As Integer
Cnt = 0
Dim myDoc As Word.Document

For Each f1 In fc
Dim WithoutExt As String
WithoutExt = LCase(Right(f1.Name, 4))
Dim FileName As String
FileName = Left(f1.Name, Len(f1.Name) - 4)
If WithoutExt = LCase(".doc") Then
WordBasic.DisableAutoMacros 1
Application.Documents.Open FileName:=f & "\" & f1.Name,
Visible:=False
Set myDoc = Application.Documents(f & "\" & f1.Name)
myDoc.PrintOut
myDoc.Close savechanges:=False
Set myDoc = Nothing
WithoutExt = ""
FileName = ""
WordBasic.DisableAutoMacros 0
End If
Next
End Sub


We are using MS Office XP here. Thank you in advance!

[jlawson]

Ed the code is wonderful! Thank you so much!

I had to make a few changes to get it to work but all the genius is
strictly yours. I'll show you the changes below:

Private Sub BatchFilePrint_Click()
Dim oFSO 'As Scripting.FileSystemObject
Dim oFolder 'As Folder
Dim oFile 'As File
Dim oDoc As Word.Document
Dim Extension As String
Dim StartDate As String
Dim EndDate As String
Dim FileModifiedDate As String
Dim Msg As String
Dim NumFilesToPrint As Integer
Dim Response As VbMsgBoxResult

'Const FolderPath As String = "S:\After Hours Scheduling\Requests"
Const AppTitle As String = "Schedules Print"
Const MaxFilesToPrint As Integer = 10

On Error GoTo ErrHandler

If Not DateOK(txtStartDate.Text) Then
MsgBox "Invalid start date", vbExclamation, AppTitle
Exit Sub
End If

If Not DateOK(txtEndDate.Text) Then
MsgBox "Invalid end date", vbExclamation, AppTitle
Exit Sub
End If

StartDate = Right(txtStartDate.Text, 4) & Left(txtStartDate.Text, 2)
& _
Mid(txtStartDate.Text, 4, 2)
EndDate = Right(txtEndDate.Text, 4) & Left(txtEndDate.Text, 2) & _
Mid(txtEndDate.Text, 4, 2)

If StartDate EndDate Then
MsgBox "The start date is later than the end date", vbExclamation,
AppTitle
Exit Sub
End If

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("S:\After Hours Scheduling\Requests")

For Each oFile In oFolder.Files
Extension = LCase(Right(oFile.Name, 4))
If Extension = ".doc" And Left(oFile.Name, 1) "~" Then
FileModifiedDate = Format(oFile.DateLastModified, "yyyymmdd")
If FileModifiedDate = StartDate And FileModifiedDate =
EndDate Then
NumFilesToPrint = NumFilesToPrint + 1
End If
End If
Next

If NumFilesToPrint MaxFilesToPrint Then
Msg = "Are you sure you want to print " & NumFilesToPrint & "
files?"
Response = MsgBox(Msg, vbQuestion + vbYesNo, AppTitle)
If Response = vbNo Then
Exit Sub
End If
End If

ToggleProtectDoc
WordBasic.DisableAutoMacros 1

For Each oFile In oFolder.Files
Extension = LCase(Right(oFile.Name, 4))
If Extension = ".doc" And Left(oFile.Name, 1) "~" Then
FileModifiedDate = Format(oFile.DateLastModified, "yyyymmdd")
If FileModifiedDate = StartDate And FileModifiedDate =
EndDate Then
Set oDoc = Documents.Open(FileName:=oFile.Path,
Visible:=False)
oDoc.PrintOut
oDoc.Close savechanges:=wdDoNotSaveChanges
End If
End If
Next
WordBasic.DisableAutoMacros 0
ToggleProtectDoc

The rest worked great! Thank you again!

[Ed]

Hi again,

You're welcome.

Regarding the changes you needed to make to the three Dim statements - I'm
guessing that you got an error saying something like "User-defined type not
defined".
The Scripting.FileSystemObject isn't part of VBA itself; it is functionality
that is provided by an external library. I ought to have told you to add a
reference to this library in your VBA project. To do that you click on
Tools/References and tick the entry for "Microsoft Scripting Runtime". Once
you've done that then VBA "knows about" the FileSystemObject and the other
stuff that's included in the Scripting Runtime library such as the file and
folder objects and it should let you declare objects of those types.

Glad you managed to make it work.

Regards.

Ed
"jlawson" wrote:

Ed the code is wonderful! Thank you so much!

I had to make a few changes to get it to work but all the genius is
strictly yours. I'll show you the changes below:

Private Sub BatchFilePrint_Click()
Dim oFSO 'As Scripting.FileSystemObject
Dim oFolder 'As Folder
Dim oFile 'As File
Dim oDoc As Word.Document
Dim Extension As String
Dim StartDate As String
Dim EndDate As String
Dim FileModifiedDate As String
Dim Msg As String
Dim NumFilesToPrint As Integer
Dim Response As VbMsgBoxResult

'Const FolderPath As String = "S:\After Hours Scheduling\Requests"
Const AppTitle As String = "Schedules Print"
Const MaxFilesToPrint As Integer = 10

On Error GoTo ErrHandler

If Not DateOK(txtStartDate.Text) Then
MsgBox "Invalid start date", vbExclamation, AppTitle
Exit Sub
End If

If Not DateOK(txtEndDate.Text) Then
MsgBox "Invalid end date", vbExclamation, AppTitle
Exit Sub
End If

StartDate = Right(txtStartDate.Text, 4) & Left(txtStartDate.Text, 2)
& _
Mid(txtStartDate.Text, 4, 2)
EndDate = Right(txtEndDate.Text, 4) & Left(txtEndDate.Text, 2) & _
Mid(txtEndDate.Text, 4, 2)

If StartDate EndDate Then
MsgBox "The start date is later than the end date", vbExclamation,
AppTitle
Exit Sub
End If

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("S:\After Hours Scheduling\Requests")

For Each oFile In oFolder.Files
Extension = LCase(Right(oFile.Name, 4))
If Extension = ".doc" And Left(oFile.Name, 1) "~" Then
FileModifiedDate = Format(oFile.DateLastModified, "yyyymmdd")
If FileModifiedDate = StartDate And FileModifiedDate =
EndDate Then
NumFilesToPrint = NumFilesToPrint + 1
End If
End If
Next

If NumFilesToPrint MaxFilesToPrint Then
Msg = "Are you sure you want to print " & NumFilesToPrint & "
files?"
Response = MsgBox(Msg, vbQuestion + vbYesNo, AppTitle)
If Response = vbNo Then
Exit Sub
End If
End If

ToggleProtectDoc
WordBasic.DisableAutoMacros 1

For Each oFile In oFolder.Files
Extension = LCase(Right(oFile.Name, 4))
If Extension = ".doc" And Left(oFile.Name, 1) "~" Then
FileModifiedDate = Format(oFile.DateLastModified, "yyyymmdd")
If FileModifiedDate = StartDate And FileModifiedDate =
EndDate Then
Set oDoc = Documents.Open(FileName:=oFile.Path,
Visible:=False)
oDoc.PrintOut
oDoc.Close savechanges:=wdDoNotSaveChanges
End If
End If
Next
WordBasic.DisableAutoMacros 0
ToggleProtectDoc

The rest worked great! Thank you again!