How do I print documents from a folder within a certain date range?

  • Thread starter Thread starter jlawson
  • Start date Start date
J

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 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!
 
Back
Top