[AccessD] word automation not printing

Hi John

You may choose to print the document in the background:

<code>

Function WordDocPrint( _
  ByVal strFilename As String, _
  Optional ByVal booPrintBackGround As Boolean = False) _
  As Boolean

' Print Word document from within Access.
' 2000-05-27. Gustav Brock. Cactus Data ApS.
' 2000-09-10. Modified with option for background printing.

' Example: ? WordDocPrint("C:\Programmer\Microsoft Office 97\Office\Eksempler\produkter.doc")

  Dim appWord     As Word.Application
  Dim booSuccess  As Boolean
  
  Set appWord = New Word.Application
  Debug.Print "- activated"

  With appWord
    If Len(Dir(strFilename)) > 0 Then
      ' Open document strFilename read-only.
      .Documents.Open strFilename, , True
      Debug.Print "- opened"
      .ActiveDocument.PrintOut booPrintBackGround
      While .BackgroundPrintingStatus > 0
        Debug.Print "- printing"
        DoEvents
      Wend
      Debug.Print "- printed"
      .ActiveDocument.Close
      Debug.Print "- closed"
      booSuccess = True
    End If
    .Quit
    Debug.Print "- quit"
  End With
  
  Set appWord = Nothing
  
  WordDocPrint = booSuccess

End Function

</code>

/gustav


> I am using the following code to print an existing document using word
> automation.  If I leave out the msgbox statement the document doesn't print.
> It's almost as if the close happens before the print manages to get the
> document out of word and into the print queue.  Has anyone seen this?  Any
> suggestions?  The "Press any key" solution is unprofessional to say the
> least.

> Function PrintWordDoc(strFilePath As String, strFileName As String, intCnt
> As Integer) As Boolean
> On Error GoTo Err_PrintWordDoc
>     Dim AppWord As Word.Application
>     Dim lDoc As Word.Document
>     Set AppWord = CreateObject("Word.Application")
>     With AppWord
>         .Visible = True
>         .Documents.Open (strFilePath & strFileName)
>         Set lDoc = .Documents(strFileName)
>         lDoc.PrintOut , , , , , , , intCnt

>         msgbox "Press any key to continue"

>         .Quit savechanges:=False
>     End With
>     PrintWordDoc = True
> Exit_PrintWordDoc:
> On Error Resume Next
>     Set lDoc = Nothing
>     Set AppWord = Nothing
> Exit Function
> Err_PrintWordDoc:
>         MsgBox Err.Description, , "Error in Sub basMailMerge.PrintWordDoc"
>         Resume Exit_PrintWordDoc
>     Resume 0    '.FOR TROUBLESHOOTING
> End Function