Results 1 to 2 of 2
  1. #1
    2 Star Lounger
    Join Date
    Jul 2003
    Park City, Utah
    Thanked 0 Times in 0 Posts

    Print 'Copy 1', 'Copy 2' Notation (2000)

    We need to automate the printping of copies of the same Word document with the Copy 1, Copy 2, Copy 3 notations in the footer. We need to print the entire directory of documens with Copy 1, then the same directory with Copy 2, etc.
    1. Anyone know of 3rd party software that will do this or
    2. Anyone know of an existing macro that will do this, or even parts of the process?


  2. #2
    3 Star Lounger
    Join Date
    Apr 2004
    Boston, Massachusetts, USA
    Thanked 0 Times in 0 Posts

    Re: Print 'Copy 1', 'Copy 2' Notation (2000)

    You haven't said how you planned to implement the copy number in the footer (you could insert it manually, or use a field with a document variable, or even do a PRINT field), but this should get you started. You could add some code to give you a dialog from which to choose a folder, but this should work as a demo. It prompts for a folder, then the number of copies, then opens each Word doc in the folder, adds the copy number to the footer, prints it out and closes it. The macro loops as many times as copy numbers you've specified.

    With a bit of modification, you could print each copy of the same document while that document was open, which would speed things up a bit, but would make for slightly more complex code.

    Hope this helps get you moving in the right direction.

    <pre>Sub PrintNumberedCopiesOfAllFilesInFolder()
    Dim i As Integer
    Dim k As Integer
    Dim doc As Document
    Dim sFileFullName As String
    Dim sFileName As String
    Dim sFolder As String
    Dim lngNumberCopies As Long
    Dim rng As Range

    sFolder = InputBox("Enter folder name")
    If Len(sFolder) = 0 Then Exit Sub
    lngNumberCopies = CLng(InputBox("How many copies?"))
    If lngNumberCopies = 0 Then Exit Sub

    For k = 1 To lngNumberCopies
    With Application.FileSearch
    .LookIn = sFolder
    .SearchSubFolders = False
    .FileType = msoFileTypeWordDocuments
    If Not .Execute() = 0 Then
    For i = 1 To .FoundFiles.Count
    sFileFullName = .FoundFiles(i)
    sFileName = Right$(sFileFullName, _
    (Len(sFileFullName) - _
    (InStrRev(sFileFullName, ""))))
    ' Ignore temp files (beginning with ~)
    If sFileName Like "[!~]*" Then
    Set doc = Documents.Open(sFileFullName)
    ' Code to add copy number to footer
    ' and print out. Then close without saving
    Set rng = doc.StoryRanges(wdPrimaryFooterStory)
    rng.InsertAfter "Copy " & CStr(k)
    doc.Saved = True
    Set doc = Nothing
    End If
    Next i
    MsgBox "No files matched " & .FileName
    End If
    End With
    Next k
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts