Source code for Issue Number 95

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home

Source Code

Create a new class module and paste this source code into it. You should name this class cWordIntegration. If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    cWordIntegration
'   Written By:     C&D Programming Corp.
'   Create Date:    3/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Private oApp As Word.Application            ' contains the currently active instance of
                                            ' the Word object

Private msDocumentName As String            ' stores the current document name
Public Filename As String                   ' Currently opened filename
Private mvFileFormat As Word.WdSaveFormat   ' type of file about to be saved.

Private Sub Class_Initialize()
    Set oApp = Nothing
End Sub

Private Sub Class_Terminate()
    If AppIsOpened Then
        oApp.Quit
    End If
End Sub

'
'   Returns True if this class opened a copy of Word.
'
Public Property Get AppIsOpened() As Boolean
    AppIsOpened = Not (oApp Is Nothing)
End Property

'
'   Opens an instance of Microsoft Word.
'
Public Sub AppOpen(bVisible As Boolean)
    If Not AppIsOpened Then
        Set oApp = New Word.Application
    End If
    oApp.Visible = bVisible
End Sub

Public Sub AppClose()
    If AppIsOpened Then
        oApp.Quit
        Set oApp = Nothing
    End If
End Sub

Private Sub AppCheck()
    If AppIsOpened Then
        Exit Sub
    Else
        AppOpen True    ' make visible by default
    End If
End Sub

Public Sub FileOpen()
    On Error GoTo Handler
    AppCheck

    oApp.Documents.Open Filename

    ' retrieves the document name that will be used in the documents collection.
    ' this is usually the same as the filename portion of the full filename to
    ' open.
    msDocumentName = oApp.ActiveDocument.Name
    Exit Sub

Handler:
    Err.Raise Err.Number, "FileOpen", Err.Description
End Sub

Public Sub FileClose(bSave As Boolean)
    On Error GoTo Handler
    AppCheck
    If bSave Then
        oApp.Documents(msDocumentName).Save
    End If
    Call oApp.Documents(msDocumentName).Close
    Exit Sub

Handler:
    Err.Raise Err.Number, "FileClose", Err.Description
End Sub

Public Sub FileSave()
    On Error GoTo Handler
    AppCheck
    Call oApp.Documents(msDocumentName).Save
    Exit Sub

Handler:
    Err.Raise Err.Number, "FileSave", Err.Description
End Sub

'
' Refer to the SaveFormat property in the help file Vbawrd8.hlp (which
' is usually located in the "C:\Program Files\Microsoft Office\Office"
' folder.  Some of the more common choices are:
'
'   wdFormatDocument - Normal Word Document
'   wdFormatDOSText - DOS Text
'   wdFormatDOSTextLineBreaks - DOS Text with line breaks
'   wdFormatRTF - Rich Text Format
'   wdFormatTemplate - Normal Word Template
'   wdFormatText - Plain Text
'   wdFormatTextLineBreaks - Plain Text with line breaks
'   wdFormatUnicodeText - Unicode Text
'
'
Public Property Let FileFormat(vFileFormat As Word.WdSaveFormat)
    mvFileFormat = vFileFormat
End Property

'
'   You can use this to pass a custom file format string.  An example would be
'   WrdPrfctDat for WordPerfect 5.1 or 5.2 secondary file format.
'
Public Property Let FileFormatCustom(sFileFormat As String)
    mvFileFormat = oApp.FileConverters(sFileFormat).SaveFormat
End Property

Public Property Get FileFormat() As Word.WdSaveFormat
    FileFormat = mvFileFormat
End Property

Public Sub FileFormatList(lst As Variant)
    Dim fc As Variant

    AppCheck

    If TypeName(lst) <> "ListBox" And TypeName(lst) <> "ComboBox" Then
        Err.Raise 5, "FileFormatList", "Only combo boxes and list boxes are supported in this routine."
    End If

    lst.Clear
    For Each fc In oApp.FileConverters
        If fc.CanSave Then
            lst.AddItem fc.FormatName
            lst.ItemData(lst.NewIndex) = fc.SaveFormat
        End If
    Next fc
End Sub

Public Sub FileSaveAs()
    On Error GoTo Handler
    AppCheck
    oApp.Documents(msDocumentName).Activate
    Call oApp.Documents.Item(msDocumentName).SaveAs(Filename, FileFormat)
    msDocumentName = oApp.ActiveDocument.Name
    Exit Sub

Handler:
    Err.Raise Err.Number, "FileSaveAs", Err.Description
End Sub