none
Calling methods on Word document (OLE object) retrieved from database

    Question

  • Hi,

    I have a table that contains Word documents stored as OLE objects by Bound Object containers. I don't have the form nor the containers that created the objects at hand, just a result set. I'd like to save the documents to disk (via the SaveAs method) to merge them into a template (by means of InsertFile). How can I convert the values in the result set back to OLE objects ?

    Thanks,
    Jean-Louis
    Monday, June 14, 2010 1:24 PM

Answers

  • Jean-Louis,

    I have figured out a solution that will save Microsoft Word documents stored in an OLE-Object field in a table.  If that's what you want, then the solution below should do the trick.

    The method I have used assumes you can create a form using the AutoForm wizard on the table.  This will create on the form a BoundObjectFrame control bound to the OLE-Object field containing the Word documents. The properties of the control are used to load the Word document currently in the control into Microsoft Word and Word then saves the document. The form is then moved to the next record in the table and the process is repeated until you have saved all documents in all records in the table.  This is a fairly slow process, so be ready to put your feet up with a cup of coffee if you have many records!

    The code below has notes to explain what's going on.  It's lengthy, but I needed to get to the bottom of this problem anyway.  Copy the code below and paste it into a new module in your database. You may want to create a new Yes/No field named "Unsaved" in your table. The procedure below will write TRUE to that field in a record when a Word document is not saved, e.g. if the field is empty or contains another type of object (like an Excel spreadsheet).

    Geoff

     

    Option Compare Database
    Option Explicit

    '   This module requires a reference to:
    '
    '       Microsoft DAO 3.6 Object Library

    '       Microsoft Word Object Library
    '
    '   To set the reference, in the VBA editor:
    '   Tools > References.


    '   The timeGetTime function returns the number
    '   of milliseconds that have elapsed since
    '   since the current Windows session started:
    Private Declare Function timeGetTime _
        Lib "winmm.dll" () As Long

    '   Variable to store the start time:
    Private mlngStartTime As Long


    Private Sub SaveDocuments()

        ' PURPOSE:
        '
        '   To save Word documents stored in an
        '   OLE-Object field in a table.
        '
        '   This procedure uses these steps:
        '
        '   1.  Starts Microsoft Word.
        '   2.  Opens a form whose RecordSource is the
        '       table. (If the form is created using the
        '       AutoForm wizard on the table, a
        '       BoundObjectFrame control is created on
        '       the form bound to the OLE-Object field.)
        '   2.  Moves the form through all records
        '       in the table.
        '   3.  Uses the BoundObjectFrame control to load
        '       the ActiveX object in the control into
        '       its OLE-server application.
        '       If the ActiveX object is a Word document,
        '       the object is loaded into the running
        '       instance of Microsoft Word.
        '   4.  Attempts to save the ActiveX object using
        '       Microsoft Word.  If the object is a Word
        '       document, the object is saved; if the
        '       object is not a Word document, the
        '       run-time error is trapped and the object
        '       is ignored.
        '
        ' NOTES ON APPROACH ADOPTED
        '
        '   This solution does not use the Object property
        '   of the BoundObjectFrame control. In tests,
        '   the Object property would only return a
        '   reference to the Automation server of the
        '   ActiveX object (contained in the control)
        '   once, for the first record in the table.
        '   When you move the form to the second and
        '   subsequent records, the Object property
        '   returns a reference that is not connected
        '   to the OLE server. It is not clear why this
        '   happens.  It seems there should be a way
        '   round this, but I can't discover what it is.
        '
        '   This means that you can't use the Object
        '   property when looping through all records
        '   in a table.
        '
        '   The advantage of the Object property is that
        '   it gives access to the properties and methods
        '   of the object. One of those methods is
        '   "SaveAs". Therefore, using the Object property
        '   should enable the saving of any type of
        '   ActiveX object, not just Word documents
        '   (assuming the OLE server applications are
        '   installed for all objects).
        '
        '   Whether using the Object property would be
        '   slower remains unknown.
        '
        '   TIME TO EXECUTE:
        '
        '   If there are many records in the table,
        '   this procedure could take a long time
        '   to complete.  Therefore, the choice of
        '   saving a number of records is given so
        '   that tests can be run on a few records.
        '   The Windows API function, timeGetTime(),
        '   is used to measure elapsed time.
       

        '   The name of the form containing the
        '   BoundObjectFrame control bound to the
        '   OLE field.
        Const strcFormName As String = "frmOLETable1"

        '   The name of the BoundObjectFrame control
        '   on the form:
        Const strcOLEControl As String = "oleWordDoc"

        '   The name of the Yes/No field to which TRUE
        '   will be written:
        '   (a) if the ActiveX object is not saved or
        '   (b) if an empty OLE-Object field is found.
        '   If this field does not exist use an empty
        '   string "" as the field name:
        Const strcUnsavedFieldName As String = "Unsaved"
       
        '   Declare object variables:
        Dim objAO As Access.AccessObject
        Dim objWRD As Word.Application
        Dim objFRM As Access.Form
        Dim objCTRL As BoundObjectFrame
        Dim objRS As DAO.Recordset
        Dim objFLD As DAO.Field
        Dim objFLDUnsaved As DAO.Field

        '   Declare working variables:
        Dim fStart As VbMsgBoxResult
        Dim lngStopAtRecord As Long
        Dim clngRecordCounter As Long
        Dim fFormExists As Boolean
        Dim strPath As String
        Dim fUnsavedFieldExists As Boolean
        Dim fUnsavedFieldIsYesNo As Boolean
        Dim strDocName As String
        Dim strFullPath As String
        Dim strOLEFieldName As String
        Dim lngL As Long
        Dim clngRecordsSaved As Long
        Dim clngRecordsNotSaved As Long
        Dim clngRecordsEmpty As Long
        Dim clngMilliSecondsElapsed As Long
       
       
    'As you may want to debug errors,
    'this error handler has been remmed out.
    'On Error GoTo Error_SaveDocuments
       
        '   Confirm OK to run program and ask
        '   whether only one record should be saved
        '   as a test run:
        fStart = StartConfirmation(lngStopAtRecord)
        If Not fStart Then
            Call ProgramCancelled
            GoTo Exit_SaveDocuments
        End If
       
        '   Get path to current database where the
        '   documents will be saved:
        strPath = Access.Application.CurrentProject.Path

        '   See if the form exists:
        For Each objAO In Access.CurrentProject.AllForms
            If objAO.Name = strcFormName Then
                fFormExists = True
                Exit For
            End If
        Next
        If Not fFormExists Then
            Call Msg1(strcFormName)
            GoTo Exit_SaveDocuments
        End If
       
        '   Close the form if it's open:
        If objAO.IsLoaded Then
            DoCmd.Close acForm, strcFormName, acSaveYes
        End If
       
        '   Open the form:
        DoCmd.OpenForm strcFormName
       
        '   Point to the form just opened:
        Set objFRM = Forms(Forms.Count - 1)
       
        '   Point to the ObjectFrame control:
        Set objCTRL = objFRM.Controls(strcOLEControl)
       
        '   Get the name of the field bound
        '   to the BoundObjectFrame:
        strOLEFieldName = objCTRL.ControlSource
       
        '   Clone the form's recordset:
        Set objRS = objFRM.RecordsetClone
       
        '   Point to the field in the Recordset
        '   bound to the ObjectFrame:
        Set objFLD = objRS.Fields(strOLEFieldName)
       
        '   See if the "Unsaved" field exists:
        For Each objFLDUnsaved In objRS.Fields
            If objFLDUnsaved.Name = _
                strcUnsavedFieldName Then
                    fUnsavedFieldExists = True
                Exit For
            End If
        Next
       
        '   See if the "Unsaved" field is a Yes/No field:
        If fUnsavedFieldExists Then
            If objFLDUnsaved.Type = dbBoolean Then
                fUnsavedFieldIsYesNo = True
            End If
        End If
       
        '   See if there are any records to process:
        If objRS.RecordCount = 0 Then
            DoCmd.Close acForm, strcFormName, acSaveNo
            Call Msg2(strcFormName)
            GoTo Exit_SaveDocuments
        End If
       
        '   Start the timer:
        Call StartWatch

        '   Start Microsoft Word:
        Set objWRD = New Word.Application
        objWRD.Visible = True
       
        '   Loop through all records in
        '   the form's RecordSource:
        Do Until objRS.EOF
       
            '   Make the current record in the
            '   Recordset current in the form:
            objFRM.Bookmark = objRS.Bookmark
           
            '   Jump to a subprocedure:
            GoSub SaveCurrentDocument
           
            '   Stop if user specified how many
            '   records to save:
            If lngStopAtRecord <> -1 Then
                clngRecordCounter = clngRecordCounter + 1
                If clngRecordCounter = lngStopAtRecord Then
                    Exit Do
                End If
            End If
           
            '   Move to next record in recordset:
            objRS.MoveNext
           
        Loop
       
        '   Close the recordset before the form is closed:
        If Not objRS Is Nothing Then
            objRS.Close
            Set objRS = Nothing
        End If
       
        '   Clean up before final message:
        DoCmd.Close acForm, strcFormName, acSaveNo
        GoSub QuitMicrosoftWord
       
        '   Get elapsed time:
        clngMilliSecondsElapsed = StopWatch()
       
        '   Show finished message:
        Call MsgFinished( _
            clngRecordsSaved, _
            clngRecordsNotSaved, _
            clngRecordsEmpty, _
            clngMilliSecondsElapsed, _
            fUnsavedFieldIsYesNo)
       
    Exit_SaveDocuments:
       
        '   Destroy objects.
        '   We may arrive here by way of the
        '   error-handler, if used, (which is
        '   why some objects are apparently
        '   destroyed twice).
       
        On Error GoTo Abort_SaveDocuments
        GoSub QuitMicrosoftWord
        Set objFLDUnsaved = Nothing
        Set objFLD = Nothing
        If Not objRS Is Nothing Then
            objRS.Close
            Set objRS = Nothing
        End If
        Set objCTRL = Nothing
        Set objFRM = Nothing
        Set objAO = Nothing
       
        Exit Sub
       
    Abort_SaveDocuments:

        Call MsgFinishedWithError
        Exit Sub
       
    QuitMicrosoftWord:

        If Not objWRD Is Nothing Then
            objWRD.Quit
            Set objWRD = Nothing
        End If

        Return

    SaveCurrentDocument:
       
        '   Allow the user to hit CTRL-BREAK
        '   to stop this procedure:
        DoEvents
       
        '   See if ObjectFrame field is empty:
        If IsNull(objFLD.Value) Then
            clngRecordsEmpty = clngRecordsEmpty + 1
            GoSub WriteTrueToUnsavedField
            Return
        End If
       
        '   Open the ActiveX object stored in the
        '   BoundObjectFrame control in the OLE-server
        '   application. If the object is a Word document,
        '   it will open in the running instance of Word.
        '   Trap any run-time error.
        On Error Resume Next
        With objCTRL
            .Verb = acOLEVerbOpen
            .Action = acOLEActivate
        End With
        If Err.Number <> 0 Then
            '   It seems we won't be hear unless the
            '   OLE-server application is not installed.
            '   Abandon attempt to save the object.
            On Error GoTo 0
            clngRecordsNotSaved = clngRecordsNotSaved + 1
            GoSub WriteTrueToUnsavedField
            Return
        End If
        On Error GoTo 0

        '   Create a name for the object to be saved:
        lngL = lngL + 1
        strDocName = "SavedDoc" & lngL
        strFullPath = strPath & "\" & strDocName
       
        '   Save the ActiveX object using Microsoft Word.
        '   If the current ActiveX object is not a
        '   Word document, trap the run-time error:
        On Error Resume Next
        With objWRD.ActiveDocument
            .SaveAs strFullPath
        End With
        If Err.Number <> 0 Then
            '   We'll be here if the ActiveX object
            '   is not a Word document.
            '   Abandon attempt to save object.
            clngRecordsNotSaved = clngRecordsNotSaved + 1
            GoSub WriteTrueToUnsavedField
            On Error GoTo 0
            Return
        End If
       
        '   Increment counter of saved records:
        clngRecordsSaved = clngRecordsSaved + 1
       
        '   Write to False to "Unsaved" field:
        GoSub WriteFalseToUnsavedField
       
        '   Close the Word document in the control:
        With objCTRL
            .Action = acOLEClose
        End With
       
        '   Return to next iteration of loop:
        Return

    WriteTrueToUnsavedField:

        '   Mark the record as not having been saved,
        '   by writing TRUE to the record in a Yes/No
        '   "Unsaved" field if the field exists:
        If fUnsavedFieldIsYesNo Then
            With objRS
                .Edit
                objFLDUnsaved.Value = True
                .Update
            End With
        End If

        Return

    WriteFalseToUnsavedField:

        '   Mark the record as having been saved,
        '   by writing FALSE to the record in a Yes/No
        '   "Unsaved" field if the field exists:
        If fUnsavedFieldIsYesNo Then
            With objRS
                .Edit
                objFLDUnsaved.Value = False
                .Update
            End With
        End If

        Return

    Error_SaveDocuments:

        MsgBox "Error No: " & Err.Number _
            & vbNewLine & vbNewLine _
            & Err.Description, _
            vbOKOnly + vbExclamation, _
            "Program Ended with Error"
        Resume Exit_SaveDocuments

    End Sub

    Private Function StartConfirmation( _
        clngRecordsToSave As Long) As Boolean

        '   The program's opening message.
       
        Dim fRetVal As Boolean
        Dim strInput As String
        Dim strMessage As String
        Dim msgButtons As VbMsgBoxStyle
        Dim strHeading As String
       
    Start:

        clngRecordsToSave = 0
        strMessage = "Enter the number of records to " _
            & "be saved. Existing files with the same " _
            & "name will be overwritten." _
            & vbNewLine & vbNewLine _
            & "To save all records, enter -1. This " _
            & "may take a long time."
        strHeading = "Program Start Confirmation"
        strInput = InputBox(strMessage, strHeading, 1)
        If strInput = "" Then
            fRetVal = False
        ElseIf IsNumeric(strInput) Then
            If CLng(strInput) = -1 Or _
               CLng(strInput) > 0 Then
                clngRecordsToSave = CLng(strInput)
                fRetVal = True
            Else
                GoSub InvalidEntry
                GoTo Start
            End If
        Else
            GoSub InvalidEntry
            GoTo Start
        End If
           
    Exit_StartConfirmation:

        StartConfirmation = fRetVal
        Exit Function

    InvalidEntry:

        strMessage = "Invalid entry. Please try again."
        msgButtons = vbOKOnly + vbExclamation
        strHeading = "Invalid Entry"
        MsgBox strMessage, msgButtons, strHeading
        Return

    End Function


    Private Sub ProgramCancelled()

        '   Program cancelled message.

        MsgBox "Program cancelled at your request.", _
            vbOKOnly + vbInformation, _
            "Program Finished"

    End Sub

    Private Sub Msg1(strFormName As String)

        '   Form does not exist message.
       
        Dim strMessage As String
        Dim msgButtons As VbMsgBoxStyle
        Dim strHeading As String
       
        strMessage = _
            "Form:" & vbTab & strFormName _
                & vbNewLine & vbNewLine _
            & "The above form does not exist." _
                & vbNewLine _
            & "Please change the form name and try " _
            & "again."
        msgButtons = vbOKOnly + vbExclamation
        strHeading = "Program Terminated" & Space(50)
       
        MsgBox strMessage, msgButtons, strHeading

    End Sub

    Private Sub Msg2(strFormName As String)

        '   No records to process message.
       
        Dim strMessage As String
        Dim msgButtons As VbMsgBoxStyle
        Dim strHeading As String
       
        strMessage = "Form:" & vbTab & strFormName _
            & vbNewLine & vbNewLine _
            & "The above form's RecordSource does not " _
            & "contain any records." & vbNewLine _
            & "No documents were saved."
        msgButtons = vbOKOnly + vbExclamation
        strHeading = "Program Finished"
       
        MsgBox strMessage, msgButtons, strHeading

    End Sub

    Private Sub MsgFinished( _
        clngRecordsSaved As Long, _
        clngRecordsNotSaved As Long, _
        clngRecordsEmpty As Long, _
        clngMilliSecondElapsed As Long, _
        fUnsavedFieldIsYesNo As Boolean)

        '   Program finished message.
       
        Dim strMessage As String
        Dim msgButtons As VbMsgBoxStyle
        Dim strHeading As String
       
        strMessage = _
            "Saved Records:" & vbTab & clngRecordsSaved _
                & vbNewLine _
            & "Unsaved Records:" & vbTab _
                & clngRecordsNotSaved & vbNewLine _
            & "Empty Records:" & vbTab & clngRecordsEmpty _
                & vbNewLine _
            & "Seconds Taken:" & vbTab _
                & CStr((clngMilliSecondElapsed / 1000))
        If fUnsavedFieldIsYesNo Then
            If (clngRecordsNotSaved > 0) Or _
               (clngRecordsEmpty > 0) Then
                    strMessage = strMessage _
                        & vbNewLine & vbNewLine _
                        & "Unsaved and Empty Records " _
                        & "have been flagged as unsaved."
            End If
        End If
        msgButtons = vbOKOnly + vbInformation
        strHeading = "Program Finished" & Space(60)
       
        MsgBox strMessage, msgButtons, strHeading

    End Sub

    Private Sub MsgFinishedWithError()

        '   Program couldn't destroy objects message.

        MsgBox "An error occurred while cleaning up.", _
            vbOKOnly + vbExclamation, _
            "Program Finished with Error"

    End Sub

    Public Sub StartWatch()

        '   Store the number of milliseconds
        '   since the computer was turned on.
       
        mlngStartTime = timeGetTime()
       
    End Sub

    Public Function StopWatch() As Long

        '   Return the number of elapsed milliseconds.
       
        StopWatch = timeGetTime() - mlngStartTime
       
    End Function

     

     

     

     

    • Marked as answer by Tim Li Monday, June 21, 2010 7:14 AM
    Friday, June 18, 2010 2:33 PM