applying script to v19 syntax: printing syntax file with path and filename, date and page numbers in a footer.

classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

applying script to v19 syntax: printing syntax file with path and filename, date and page numbers in a footer.

Cleland, Patricia (EDU)

I’ve just upgraded to v19.  I have a script (from Ray Levesque) that prints a syntax file with the path and filename, date and page number in the footer.  When I ran it, this is the error message I got:  

 

Error : Unterminated block statement.

At Line No : 18

 

Can anyone tell me what that means and what I need to do to fix it? To be honest, what I know about scripts could be written on the head of a pin with room left over for the entire Encyclopaedia Britannica.

 

If there’s a Python solution, I’d be happy to use that. 

 

 

 

Here’s the script:

 

'#Language "WWB-COM"

 

Option Explicit

 

Sub Main

            'BEGIN DESCRIPTION

' This script saves then prints the currently Designated Syntax file.

' The file name, path ,date, timestamp and page numbers are printed

' If the file has never been saved, the user is prompted for the file name and path

' If file is read only, saved file is printed.

' Has been tested with Word 2000 (English version)

' Raynald Levesque August 2001

' Improvement Nov 2002: at end of the script, word is closed only if it was not

'           running when the script started

' Visit my SPSS web site http://pages.infinit.net/rlevesqu/

'END DESCRIPTION

 

Public bolWordWasRunning As Boolean

 

Sub Main

' This saves then prints the currently Designated Syntax file along

' with the file name, path ,date, time and page numbers.

' If file is read only, saved file is printed.

' Assign this script to a custom button in your Syntax window toolbar

            Dim objSyntaxDoc As ISpssSyntaxDoc

            Dim strDocPath As String

            Dim strMsg As String, strTitle As String

            Dim intButtons As Integer

 

            On Error GoTo Oopps

            strDocPath = "none"

            bolWordWasRunning = True

 

            ' If there are no open syntax file, Oopps will request the full path of the file

            Set objSyntaxDoc = objSpssApp.GetDesignatedSyntaxDoc

 

            If strDocPath = "none" Then

                        strDocPath = objSyntaxDoc.GetDocumentPath

            End If

            If strDocPath = "" Then             'Syntax has never been saved, ask for path

                        strDocPath = GetFilePath (,"sps",,"Select folder and enter name for the syntax file", 2)

                        If strDocPath = "" Then Exit Sub            'User Cancelled the dialog box

            End If

 

            ' Save the current version of the syntax file

            objSyntaxDoc.SaveAs (strDocPath)      'If read only, ask if should print saved copy

            Call PrintSyntax(strDocPath)

            Exit Sub

 

Oopps:

            Select Case Err.Number

                        Case -2147467259        'There are no open syntax file, get path from user

                                    Debug.Print "There were no syntax file opened"

                                    strDocPath = GetFilePath (,"sps",,"Select the syntax file to be printed", 0)

                                    If strDocPath = "" Then Exit Sub            'User cancelled Dialog box

                                    Resume Next

                        Case -2147418113        'File is read only

                                    Debug.Print "File is read only"

                                    strMsg = "The syntax file is read only!" & vbCr & "Do you want to print the saved copy?"

                                    intButtons = vbYesNo + vbExclamation

                                    strTitle = "File Is Read only!"

                                    If MsgBox (strMsg, intButtons, strTitle) = vbNo Then Exit Sub

                                    Resume Next

                        Case Else

                                    MsgBox Err & " " & Err.Description

                                    Debug.Print Err & " " & Err.Description

                                    Exit Sub

            End Select

 

End Sub

 

 

' Define some word constants

Const wdAlignPageNumberRight           = 0

Const wdOpenFormatAuto                                 = 0

Const wdSeekMainDocument                = 0

Const wdSeekCurrentPageHeader         = 9

Const wdSeekCurrentPageFooter          = 10

Const wdFieldDate                                            = 31

Const wdfieldPage                                            = 33

Const wdFieldTime                                           = 32

Const wdPrintView                                            = 3

Const wdFieldNumPages                                  = 26

Const wdAlignParagraphCenter = 1

Const vbTab                                                                 =Chr(9)

Const wdDoNotSaveChanges                =0

 

Sub PrintSyntax(strDocPath As String)

Dim WordApp As Object

    On Error GoTo Oopps

 

    'get access to Word application (if it does not exist, Oopps will create it)

    Set WordApp=GetObject(,"Word.Application")

    With WordApp

               ' Load syntax file in word

                        .Documents.Open FileName:=strDocPath, _

                    ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _

                    PasswordDocument:="", PasswordTemplate:="", Revert:=False, _

                    WritePasswordDocument:="", WritePasswordTemplate:="", Format:= wdOpenFormatAuto

 

                        .ActiveWindow.View.Type = wdPrintView

                .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

 

                        ' Add path and file name to header

                        With .selection

                            .TypeText Text:= vbTab & strDocPath

                        End With

                .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

 

                        ' Add date, time and page number to footer

                        With .selection

                            .Fields.Add Range:=.Range, Type:=wdFieldDate

                            .TypeText Text:=" "

                            .Fields.Add Range:=.Range, Type:=wdFieldTime

                            .TypeText Text:=" " & vbTab

                            .Fields.Add Range:=.Range, Type:=wdfieldPage

                            .TypeText Text:=" of "

                            .Fields.Add Range:=.Range, Type:=wdFieldNumPages

                        End With

 

                .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

                .ActiveDocument.PrintOut Background:= False

                        ' Close document without saving changes

                        .ActiveDocument.Close SaveChanges:=False

            End With

 

            If bolWordWasRunning = False Then

            WordApp.Quit SaveChanges:=wdDoNotSaveChanges

    End If

    Set WordApp = Nothing

    Exit Sub

 

    Oopps:

            Select Case Err

                        Case 10096      'word is not running: use CreateObject

                                    Set WordApp = CreateObject("Word.Application")

'                                   WordApp.Visible = True

                                    Debug.Print "(Word was not already running)"

                                    bolWordWasRunning = False

                                    Resume Next

                        Case Else

                                    Debug.Print "error " & Err & ": " & Err.Description

                                    Set WordApp = Nothing

                                    Exit Sub

            End Select

End Sub

 

 

 

 

  

 

 

Pat

 

Reply | Threaded
Open this post in threaded view
|

Re: applying script to v19 syntax: printing syntax file with path and filename, date and page numbers in a footer.

Jon K Peck
As is, this script would not work in any version of SPSS.  To fix,
- remove the second Sub Main statement.  
- move the Public bolWordWasRunning statement above Sub Main just after the Option Explicit

Jon Peck
Senior Software Engineer, IBM
[hidden email]
312-651-3435




From:        "Cleland, Patricia (EDU)" <[hidden email]>
To:        [hidden email]
Date:        10/20/2010 08:33 AM
Subject:        [SPSSX-L] applying script to v19 syntax: printing syntax file              with path and              filename, date and page numbers in a footer.
Sent by:        "SPSSX(r) Discussion" <[hidden email]>




I’ve just upgraded to v19.  I have a script (from Ray Levesque) that prints a syntax file with the path and filename, date and page number in the footer.  When I ran it, this is the error message I got:  
 
Error : Unterminated block statement.
At Line No : 18
 
Can anyone tell me what that means and what I need to do to fix it? To be honest, what I know about scripts could be written on the head of a pin with room left over for the entire Encyclopaedia Britannica.
 
If there’s a Python solution, I’d be happy to use that.  
 
 
 
Here’s the script:
 
'#Language "WWB-COM"
 
Option Explicit
 
Sub Main
            'BEGIN DESCRIPTION
' This script saves then prints the currently Designated Syntax file.
' The file name, path ,date, timestamp and page numbers are printed
' If the file has never been saved, the user is prompted for the file name and path
' If file is read only, saved file is printed.
' Has been tested with Word 2000 (English version)
' Raynald Levesque August 2001
' Improvement Nov 2002: at end of the script, word is closed only if it was not
'           running when the script started
' Visit my SPSS web site http://pages.infinit.net/rlevesqu/
'END DESCRIPTION
 
Public bolWordWasRunning As Boolean
 
Sub Main
' This saves then prints the currently Designated Syntax file along
' with the file name, path ,date, time and page numbers.
' If file is read only, saved file is printed.
' Assign this script to a custom button in your Syntax window toolbar
            Dim objSyntaxDoc As ISpssSyntaxDoc
            Dim strDocPath As String
            Dim strMsg As String, strTitle As String
            Dim intButtons As Integer
 
            On Error GoTo Oopps
            strDocPath = "none"
            bolWordWasRunning = True
 
            ' If there are no open syntax file, Oopps will request the full path of the file
            Set objSyntaxDoc = objSpssApp.GetDesignatedSyntaxDoc
 
            If strDocPath = "none" Then
                        strDocPath = objSyntaxDoc.GetDocumentPath
            End If
            If strDocPath = "" Then             'Syntax has never been saved, ask for path
                        strDocPath = GetFilePath (,"sps",,"Select folder and enter name for the syntax file", 2)
                        If strDocPath = "" Then Exit Sub            'User Cancelled the dialog box
            End If
 
            ' Save the current version of the syntax file
            objSyntaxDoc.SaveAs (strDocPath)      'If read only, ask if should print saved copy
            Call PrintSyntax(strDocPath)
            Exit Sub
 
Oopps:
            Select Case Err.Number
                        Case -2147467259        'There are no open syntax file, get path from user
                                    Debug.Print "There were no syntax file opened"
                                    strDocPath = GetFilePath (,"sps",,"Select the syntax file to be printed", 0)
                                    If strDocPath = "" Then Exit Sub            'User cancelled Dialog box
                                    Resume Next
                        Case -2147418113        'File is read only
                                    Debug.Print "File is read only"
                                    strMsg = "The syntax file is read only!" & vbCr & "Do you want to print the saved copy?"
                                    intButtons = vbYesNo + vbExclamation
                                    strTitle = "File Is Read only!"
                                    If MsgBox (strMsg, intButtons, strTitle) = vbNo Then Exit Sub
                                    Resume Next
                        Case Else
                                    MsgBox Err & " " & Err.Description
                                    Debug.Print Err & " " & Err.Description
                                    Exit Sub
            End Select
 
End Sub
 
 
' Define some word constants
Const wdAlignPageNumberRight           = 0
Const wdOpenFormatAuto                                 = 0
Const wdSeekMainDocument                = 0
Const wdSeekCurrentPageHeader         = 9
Const wdSeekCurrentPageFooter          = 10
Const wdFieldDate                                            = 31
Const wdfieldPage                                            = 33
Const wdFieldTime                                           = 32
Const wdPrintView                                            = 3
Const wdFieldNumPages                                  = 26
Const wdAlignParagraphCenter = 1
Const vbTab                                                                 =Chr(9)
Const wdDoNotSaveChanges                =0
 
Sub PrintSyntax(strDocPath As String)
Dim WordApp As Object
    On Error GoTo Oopps
 
    'get access to Word application (if it does not exist, Oopps will create it)
    Set WordApp=GetObject(,"Word.Application")
    With WordApp
               ' Load syntax file in word
                        .Documents.Open FileName:=strDocPath, _
                    ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
                    PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                    WritePasswordDocument:="", WritePasswordTemplate:="", Format:= wdOpenFormatAuto
 
                        .ActiveWindow.View.Type = wdPrintView
                .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
 
                        ' Add path and file name to header
                        With .selection
                            .TypeText Text:= vbTab & strDocPath
                        End With
                .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
 
                        ' Add date, time and page number to footer
                        With .selection
                            .Fields.Add Range:=.Range, Type:=wdFieldDate
                            .TypeText Text:=" "
                            .Fields.Add Range:=.Range, Type:=wdFieldTime
                            .TypeText Text:=" " & vbTab
                            .Fields.Add Range:=.Range, Type:=wdfieldPage
                            .TypeText Text:=" of "
                            .Fields.Add Range:=.Range, Type:=wdFieldNumPages
                        End With
 
                .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
                .ActiveDocument.PrintOut Background:= False
                        ' Close document without saving changes
                        .ActiveDocument.Close SaveChanges:=False
            End With
 
            If bolWordWasRunning = False Then
            WordApp.Quit SaveChanges:=wdDoNotSaveChanges
    End If
    Set WordApp = Nothing
    Exit Sub
 
    Oopps:
            Select Case Err
                        Case 10096      'word is not running: use CreateObject
                                    Set WordApp = CreateObject("Word.Application")
'                                   WordApp.Visible = True
                                    Debug.Print "(Word was not already running)"
                                    bolWordWasRunning = False
                                    Resume Next
                        Case Else
                                    Debug.Print "error " & Err & ": " & Err.Description
                                    Set WordApp = Nothing
                                    Exit Sub
            End Select
End Sub
 
 
 
 
   
 
 

Pat
 

Reply | Threaded
Open this post in threaded view
|

Re: applying script to v19 syntax: printing syntax file with path and filename, date and page numbers in a footer.

Cleland, Patricia (EDU)

Thanks, Jon. That worked just fine. There are 2 little niggles needed to the script to make my syntax look really nice when I print it.

 

The path and file name prints as a header rather than as the footer.  I went into the script and changed all references of ‘Header’ to ‘Footer’ and that put the path and filename in the footer, but on the same line as the date and page number.  Is there any easy fix to force a line break in the footer before the date?

 

Also, syntax prints better on landscape than on portrait. (Portrait gives very ugly line wraps.)  Is there any way to include that in the script?

 

Pat


From: Jon K Peck [mailto:[hidden email]]
Sent: October 20, 2010 11:58 AM
To: Cleland, Patricia (EDU)
Cc: [hidden email]
Subject: Re: [SPSSX-L] applying script to v19 syntax: printing syntax file with path and filename, date and page numbers in a footer.

 

As is, this script would not work in any version of SPSS.  To fix,
- remove the second Sub Main statement.  
- move the Public bolWordWasRunning statement above Sub Main just after the Option Explicit

Jon Peck
Senior Software Engineer, IBM
[hidden email]
312-651-3435




From:        "Cleland, Patricia (EDU)" <[hidden email]>
To:        [hidden email]
Date:        10/20/2010 08:33 AM
Subject:        [SPSSX-L] applying script to v19 syntax: printing syntax file              with path and              filename, date and page numbers in a footer.
Sent by:        "SPSSX(r) Discussion" <[hidden email]>





I’ve just upgraded to v19.  I have a script (from Ray Levesque) that prints a syntax file with the path and filename, date and page number in the footer.  When I ran it, this is the error message I got:  
 
Error : Unterminated block statement.
At Line No : 18
 
Can anyone tell me what that means and what I need to do to fix it? To be honest, what I know about scripts could be written on the head of a pin with room left over for the entire Encyclopaedia Britannica.
 
If there’s a Python solution, I’d be happy to use that.  
 
 
 
Here’s the script:
 
'#Language "WWB-COM"
 
Option Explicit
 
Sub Main
            'BEGIN DESCRIPTION
' This script saves then prints the currently Designated Syntax file.
' The file name, path ,date, timestamp and page numbers are printed
' If the file has never been saved, the user is prompted for the file name and path
' If file is read only, saved file is printed.
' Has been tested with Word 2000 (English version)
' Raynald Levesque August 2001
' Improvement Nov 2002: at end of the script, word is closed only if it was not
'           running when the script started
' Visit my SPSS web site http://pages.infinit.net/rlevesqu/
'END DESCRIPTION
 
Public bolWordWasRunning As Boolean
 
Sub Main
' This saves then prints the currently Designated Syntax file along
' with the file name, path ,date, time and page numbers.
' If file is read only, saved file is printed.
' Assign this script to a custom button in your Syntax window toolbar
            Dim objSyntaxDoc As ISpssSyntaxDoc
            Dim strDocPath As String
            Dim strMsg As String, strTitle As String
            Dim intButtons As Integer
 
            On Error GoTo Oopps
            strDocPath = "none"
            bolWordWasRunning = True
 
            ' If there are no open syntax file, Oopps will request the full path of the file
            Set objSyntaxDoc = objSpssApp.GetDesignatedSyntaxDoc
 
            If strDocPath = "none" Then
                        strDocPath = objSyntaxDoc.GetDocumentPath
            End If
            If strDocPath = "" Then             'Syntax has never been saved, ask for path
                        strDocPath = GetFilePath (,"sps",,"Select folder and enter name for the syntax file", 2)
                        If strDocPath = "" Then Exit Sub            'User Cancelled the dialog box
            End If
 
            ' Save the current version of the syntax file
            objSyntaxDoc.SaveAs (strDocPath)      'If read only, ask if should print saved copy
            Call PrintSyntax(strDocPath)
            Exit Sub
 
Oopps:
            Select Case Err.Number
                        Case -2147467259        'There are no open syntax file, get path from user
                                    Debug.Print "There were no syntax file opened"
                                    strDocPath = GetFilePath (,"sps",,"Select the syntax file to be printed", 0)
                                    If strDocPath = "" Then Exit Sub            'User cancelled Dialog box
                                    Resume Next
                        Case -2147418113        'File is read only
                                    Debug.Print "File is read only"
                                    strMsg = "The syntax file is read only!" & vbCr & "Do you want to print the saved copy?"
                                    intButtons = vbYesNo + vbExclamation
                                    strTitle = "File Is Read only!"
                                    If MsgBox (strMsg, intButtons, strTitle) = vbNo Then Exit Sub
                                    Resume Next
                        Case Else
                                    MsgBox Err & " " & Err.Description
                                    Debug.Print Err & " " & Err.Description
                                    Exit Sub
            End Select
 
End Sub
 
 
' Define some word constants
Const wdAlignPageNumberRight           = 0
Const wdOpenFormatAuto                                 = 0
Const wdSeekMainDocument                = 0
Const wdSeekCurrentPageHeader         = 9
Const wdSeekCurrentPageFooter          = 10
Const wdFieldDate                                            = 31
Const wdfieldPage                                            = 33
Const wdFieldTime                                           = 32
Const wdPrintView                                            = 3
Const wdFieldNumPages                                  = 26
Const wdAlignParagraphCenter = 1
Const vbTab                                                                 =Chr(9)
Const wdDoNotSaveChanges                =0
 
Sub PrintSyntax(strDocPath As String)
Dim WordApp As Object
    On Error GoTo Oopps
 
    'get access to Word application (if it does not exist, Oopps will create it)
    Set WordApp=GetObject(,"Word.Application")
    With WordApp
               ' Load syntax file in word
                        .Documents.Open FileName:=strDocPath, _
                    ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
                    PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                    WritePasswordDocument:="", WritePasswordTemplate:="", Format:= wdOpenFormatAuto
 
                        .ActiveWindow.View.Type = wdPrintView
                .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
 
                        ' Add path and file name to header
                        With .selection
                            .TypeText Text:= vbTab & strDocPath
                        End With
                .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
 
                        ' Add date, time and page number to footer
                        With .selection
                            .Fields.Add Range:=.Range, Type:=wdFieldDate
                            .TypeText Text:=" "
                            .Fields.Add Range:=.Range, Type:=wdFieldTime
                            .TypeText Text:=" " & vbTab
                            .Fields.Add Range:=.Range, Type:=wdfieldPage
                            .TypeText Text:=" of "
                            .Fields.Add Range:=.Range, Type:=wdFieldNumPages
                        End With
 
                .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
                .ActiveDocument.PrintOut Background:= False
                        ' Close document without saving changes
                        .ActiveDocument.Close SaveChanges:=False
            End With
 
            If bolWordWasRunning = False Then
            WordApp.Quit SaveChanges:=wdDoNotSaveChanges
    End If
    Set WordApp = Nothing
    Exit Sub
 
    Oopps:
            Select Case Err
                        Case 10096      'word is not running: use CreateObject
                                    Set WordApp = CreateObject("Word.Application")
'                                   WordApp.Visible = True
                                    Debug.Print "(Word was not already running)"
                                    bolWordWasRunning = False
                                    Resume Next
                        Case Else
                                    Debug.Print "error " & Err & ": " & Err.Description
                                    Set WordApp = Nothing
                                    Exit Sub
            End Select
End Sub
 
 
 
 
   
 
 

Pat
 

Reply | Threaded
Open this post in threaded view
|

Re: applying script to v19 syntax: printing syntax file with path and filename, date and page numbers in a footer.

Jon K Peck
Wherever you are adding the file name to the footer, make it look something like this.
.TypeText Text:= vbTab & strDocPath & vbCrLf

Jon Peck
Senior Software Engineer, IBM
[hidden email]
312-651-3435




From:        "Cleland, Patricia (EDU)" <[hidden email]>
To:        <[hidden email]>
Cc:        Jon K Peck/Chicago/IBM@IBMUS
Date:        10/20/2010 11:22 AM
Subject:        RE: [SPSSX-L] applying script to v19 syntax: printing syntax file with path and filename, date and page numbers in a footer.




Thanks, Jon. That worked just fine. There are 2 little niggles needed to the script to make my syntax look really nice when I print it.
 
The path and file name prints as a header rather than as the footer.  I went into the script and changed all references of ‘Header’ to ‘Footer’ and that put the path and filename in the footer, but on the same line as the date and page number.  Is there any easy fix to force a line break in the footer before the date?
 
Also, syntax prints better on landscape than on portrait. (Portrait gives very ugly line wraps.)  Is there any way to include that in the script?
 
Pat



From: Jon K Peck [mailto:peck@...]
Sent:
October 20, 2010 11:58 AM
To:
Cleland, Patricia (EDU)
Cc:
[hidden email]
Subject:
Re: [SPSSX-L] applying script to v19 syntax: printing syntax file with path and filename, date and page numbers in a footer.

 
As is, this script would not work in any version of SPSS.  To fix,
- remove the second Sub Main statement.  

- move the Public bolWordWasRunning statement above Sub Main just after the Option Explicit


Jon Peck
Senior Software Engineer, IBM
[hidden email]
312-651-3435




From:        
"Cleland, Patricia (EDU)" <[hidden email]>
To:        
[hidden email]
Date:        
10/20/2010 08:33 AM
Subject:        
[SPSSX-L] applying script to v19 syntax: printing syntax file              with path and              filename, date and page numbers in a footer.
Sent by:        
"SPSSX(r) Discussion" <[hidden email]>






I’ve just upgraded to v19.  I have a script (from Ray Levesque) that prints a syntax file with the path and filename, date and page number in the footer.  When I ran it, this is the error message I got:  

 
Error : Unterminated block statement.

At Line No : 18

 
Can anyone tell me what that means and what I need to do to fix it? To be honest, what I know about scripts could be written on the head of a pin with room left over for the entire Encyclopaedia Britannica.

 
If there’s a Python solution, I’d be happy to use that.  

 
 
 
Here’s the script:

 
'#Language "WWB-COM"

 
Option Explicit

 
Sub Main

           'BEGIN DESCRIPTION

' This script saves then prints the currently Designated Syntax file.

' The file name, path ,date, timestamp and page numbers are printed

' If the file has never been saved, the user is prompted for the file name and path

' If file is read only, saved file is printed.

' Has been tested with Word 2000 (English version)

' Raynald Levesque August 2001

' Improvement Nov 2002: at end of the script, word is closed only if it was not

'           running when the script started

' Visit my SPSS web site
http://pages.infinit.net/rlevesqu/
'END DESCRIPTION

 
Public bolWordWasRunning As Boolean

 
Sub Main

' This saves then prints the currently Designated Syntax file along

' with the file name, path ,date, time and page numbers.

' If file is read only, saved file is printed.

' Assign this script to a custom button in your Syntax window toolbar

           Dim objSyntaxDoc As ISpssSyntaxDoc

           Dim strDocPath As String

           Dim strMsg As String, strTitle As String

           Dim intButtons As Integer

 
           On Error GoTo Oopps

           strDocPath = "none"

           bolWordWasRunning = True

 
           ' If there are no open syntax file, Oopps will request the full path of the file

           Set objSyntaxDoc = objSpssApp.GetDesignatedSyntaxDoc

 
           If strDocPath = "none" Then

                       strDocPath = objSyntaxDoc.GetDocumentPath

           End If

           If strDocPath = "" Then             'Syntax has never been saved, ask for path

                       strDocPath = GetFilePath (,"sps",,"Select folder and enter name for the syntax file", 2)

                       If strDocPath = "" Then Exit Sub            'User Cancelled the dialog box

           End If

 
           ' Save the current version of the syntax file

           objSyntaxDoc.SaveAs (strDocPath)      'If read only, ask if should print saved copy

           Call PrintSyntax(strDocPath)

           Exit Sub

 
Oopps:

           Select Case Err.Number

                       Case -2147467259        'There are no open syntax file, get path from user

                                   Debug.Print "There were no syntax file opened"

                                   strDocPath = GetFilePath (,"sps",,"Select the syntax file to be printed", 0)

                                   If strDocPath = "" Then Exit Sub            'User cancelled Dialog box

                                   Resume Next

                       Case -2147418113        'File is read only

                                   Debug.Print "File is read only"

                                   strMsg = "The syntax file is read only!" & vbCr & "Do you want to print the saved copy?"

                                   intButtons = vbYesNo + vbExclamation

                                   strTitle = "File Is Read only!"

                                   If MsgBox (strMsg, intButtons, strTitle) = vbNo Then Exit Sub

                                   Resume Next

                       Case Else

                                   MsgBox Err & " " & Err.Description

                                   Debug.Print Err & " " & Err.Description

                                   Exit Sub

           End Select

 
End Sub

 
 
' Define some word constants

Const wdAlignPageNumberRight           = 0

Const wdOpenFormatAuto                                 = 0

Const wdSeekMainDocument                = 0

Const wdSeekCurrentPageHeader         = 9

Const wdSeekCurrentPageFooter          = 10

Const wdFieldDate                                            = 31

Const wdfieldPage                                            = 33

Const wdFieldTime                                           = 32

Const wdPrintView                                            = 3

Const wdFieldNumPages                                  = 26

Const wdAlignParagraphCenter = 1

Const vbTab                                                                 =Chr(9)

Const wdDoNotSaveChanges                =0

 
Sub PrintSyntax(strDocPath As String)

Dim WordApp As Object

   On Error GoTo Oopps

 
   'get access to Word application (if it does not exist, Oopps will create it)

   Set WordApp=GetObject(,"Word.Application")

   With WordApp

              ' Load syntax file in word

                       .Documents.Open FileName:=strDocPath, _

                   ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _

                   PasswordDocument:="", PasswordTemplate:="", Revert:=False, _

                   WritePasswordDocument:="", WritePasswordTemplate:="", Format:= wdOpenFormatAuto

 
                       .ActiveWindow.View.Type = wdPrintView

               .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

 
                       ' Add path and file name to header

                       With .selection

                           .TypeText Text:= vbTab & strDocPath

                       End With

               .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

 
                       ' Add date, time and page number to footer

                       With .selection

                           .Fields.Add Range:=.Range, Type:=wdFieldDate

                           .TypeText Text:=" "

                           .Fields.Add Range:=.Range, Type:=wdFieldTime

                           .TypeText Text:=" " & vbTab

                           .Fields.Add Range:=.Range, Type:=wdfieldPage

                           .TypeText Text:=" of "

                           .Fields.Add Range:=.Range, Type:=wdFieldNumPages

                       End With

 
               .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

               .ActiveDocument.PrintOut Background:= False

                       ' Close document without saving changes

                       .ActiveDocument.Close SaveChanges:=False

           End With

 
           If bolWordWasRunning = False Then

           WordApp.Quit SaveChanges:=wdDoNotSaveChanges

   End If

   Set WordApp = Nothing

   Exit Sub

 
   Oopps:

           Select Case Err

                       Case 10096      'word is not running: use CreateObject

                                   Set WordApp = CreateObject("Word.Application")

'                                   WordApp.Visible = True

                                   Debug.Print "(Word was not already running)"

                                   bolWordWasRunning = False

                                   Resume Next

                       Case Else

                                   Debug.Print "error " & Err & ": " & Err.Description

                                   Set WordApp = Nothing

                                   Exit Sub

           End Select

End Sub

 
 
 
 
 
 
 
 

Pat