Store OLE object in a table using VBA

[billlagr]

Hi All
I need to store an OLE object (short MS-Word doc.) in a table.
The table is fairly simple -

Table name - AreaLetters

ID_Number - primary key, auto increment
Area - Character, 40 characters - contains an area name, eg East, West
Letter - OLE Object

I need to open a dialog box to allow the user to select the Word doc, and store it in the Letter field, for each Area. The dialog box etc is working fine, I just need the actual VB to open/read the Word doc and store it in the OLE Object field!

Thanks
Bill

 

[MajP]

What version of Access? If you have 2007 or later there is no logical reason to use an OLE field. You should be using an attachment field.

 

[billlagr]

Oh, sorry, forgot to mention that. 2003.

 

[billlagr]

I've nearly got something working..
I have a simple database with one table -
TestTable, 2 fields
ID - Auto Increment primary key
Doc - OLEObject

The code sort of works, but instead of inserting as a Word doc, the doc is inserted as 'Long binary Data' which of course won't display in a bound frame.
Any ideas?

--
Dim FilePath As String
Dim TestRec As Recordset
Dim DB As Database

FilePath = "D:\Test.doc"
Set db = CurrentDb
Set testRec = db.OpenRecordset("TestTable")

Documents.Open (FilePath)
Documents(1).Activate
testRec.AddNew
testRec.Fields("Doc") = ActiveDocument.Content
testRec.Update

--
Thanks,
Bill

 

[billlagr]

Sorry, forgot to add..with the above, MS Word is already open, and I can open/close it through VB so that isn't an issue.
If I manually select, copy, paste from a Word doc into the Access table OLE Object field, the type shows up as 'Word Document' rather than 'Long Binary Data'. I'm essentially trying to duplicate this through VBA.

Thanks.

 

[MajP]

Without Access 2007 your database will bloat quickly for every OLE object. So you may consider just storing a link in the ole field, a hyperlink in a hyperlink field, or simply a path in a text field.

To get an ole file browser simply

Private Sub cmdOLE_Click()
'Have to set focus to ole field
Me.oleDoc.SetFocus
DoCmd.RunCommand acCmdInsertObject
End Sub

 

[strongm]

http://support.microsoft.com/kb/205635

may be of some assistance. Using a bound frame as a proxie really is the easiest way of doing this

 

[billlagr]

I will give it a try, Thanks!
I was aware that it may bloat, but there will be no more than 5 1-page Word docs at any time in the DB, I figured I could live with that

 

[billlagr]

I'm still not having much luck..
What I'm trying to accomplish is -
each month I run a number of reports, approx. 100 or so, divided into 5 areas - EAST,WEST,NORTH,SOUTH,CENTRAL.
Each of the managers for those areas provides me with a short (<1 page) letter in Word, that goes on the first page of the report. I would like to somehow open a file dialog, choose the letter for EAST, a dialog for WEST etc etc and have the report come out with the appropriate letter on the first page.
I don't really care how it's accomplished. I've tried setting the .DocSource property of an unbound OLE object, passing the file path, I've tried storing the letter in a seperate table along with the area and setting the control source of a bound OLE object. This approach DOES work, as long as I manually cut/paste the letter into the table. If I insert the letter into the table through VBA, it is inserted as 'Long Binary Data' and not 'Word Document' - which of course, won't display.
I'm kind of out of ideas. The link to the MS support doc that strongm posted looks like it's on the right track, but my Access doesn't seem to HAVE some of the controls specified.
The documents don't even necessarily have to be in Word - RTF would be fine. However, plain text is unfortunately not acceptable.
Anyone??

 

[MajP]

AFAIK Strongms approach is for a visual basic front end only. The Access OLE controls do not support the createEmbed method.
The approach I gave provides the native ole file browser. Only difference is that this requires one extra mouse click in selecting the type of document to insert.

I may be wrong on this one and maybe someone else can answer. With a form you can set the sourcedoc at runtime, with a report I have never had any luck. The technique to do this using an unbound ole on a report is in code:
1) open the report in design view hidden
2) set the sourcedoc
3) save the report
4) open the report
Maybe there is a another way to do this at runtime, I just have never figured out the correct combination of steps to make it work.

 

[strongm]

Sorry. Not completely the right link. CreateEmbed is done slightly differently in Access

Ok - assume we have a table with an OLE field in it called 'test'

create an Access Form based on that table, with a bound frame that is bound to test. Assume control is called OLEBound1

Put a command button on the form with the following code behind it:

Private Sub Command1_Click()

[OLEBound1].OLETypeAllowed = acOLEEmbedded
[OLEBound1].SourceDoc = "c:\wordtest.doc" ' your document here
[OLEBound1].Action = acOLECreateEmbed

End Sub

 

[MajP]

I am sorry for the confusion. I got this thread confused with the post dealing with rendering documents in a Report from a link. This one is relatively easy.

Here is how you make a command button to search for a Word document and insert into a Forms ole.
code on form

Private Sub cmdOLE_Click()
  Dim strWordDoc As String
  Dim ctl As Access.Control
  strWordDoc = getWordDoc
  Set ctl = Me.ctlOleDoc
  DisplayDoc ctl, strWordDoc
End Sub

generic code to set source doc

Public Function DisplayDoc(ctlDocControl As Control, strDocPath As Variant) As String
 ' On Error GoTo Err_DisplayDoc
  Dim strResult As String
  Dim strDatabasePath As String
  Dim intSlashLocation As Integer
  Dim strImagePath
  With ctlDocControl
          .Visible = True
          .Enabled = True
          .Locked = False
          ' Specify what kind of object can appear in the field.
          .OLETypeAllowed = acOLELinked
          ' Class statement--optional for Excel worksheet.
          .Class = "Microsoft Word Document"
          .SourceDoc = strDocPath
          .Action = acOLECreateLink
          ' Optional size adjustment.
          .SizeMode = acOLESizeZoom
          strResult = "Document found and displayed."
  End With
      
Exit_DisplayDoc:
      DisplayDoc = strResult
      Exit Function
  
Err_DisplayDoc:
      Select Case Err.Number
          Case 2101       ' Can't find the picture.
              ctlDocControl.Visible = False
              strResult = "Can't find document."
              Resume Exit_DisplayDoc:
          Case 2455
              Resume Next
          Case Else       ' Some other error.
              MsgBox Err.Number & " " & Err.Description
              strResult = "An error occurred displaying document."
              Resume Exit_DisplayDoc:
      End Select
  End Function

Standard File browsing code

' This code was originally written by Ken Getz.
' It is not to be altered or distributed, 'except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code originally courtesy of:
' Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996
' Revised to support multiple files:
' 28 December 2007

Type tagOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Public Function ahtCommonFileOpenSave( _
            Optional ByRef Flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal Filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal FileName As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hwnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant

    ' This is the entry point you'll use to call the common
    ' file open/save dialog. The parameters are listed
    ' below, and all are optional.
    '
    ' In:
    ' Flags: one or more of the ahtOFN_* constants, OR'd together.
    ' InitialDir: the directory in which to first look
    ' Filter: a set of file filters, set up by calling
    ' AddFilterItem. See examples.
    ' FilterIndex: 1-based integer indicating which filter
    ' set to use, by default (1 if unspecified)
    ' DefaultExt: Extension to use if the user doesn't enter one.
    ' Only useful on file saves.
    ' FileName: Default value for the file name text box.
    ' DialogTitle: Title for the dialog.
    ' hWnd: parent window handle
    ' OpenFile: Boolean(True=Open File/False=Save As)
    ' Out:
    ' Return Value: Either Null or the selected filename
    Dim OFN As tagOPENFILENAME
    Dim strFileName As String
    Dim strFileTitle As String
    Dim fResult As Boolean

    ' Give the dialog a caption title.
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(FileName) Then FileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    ' Allocate string space for the returned strings.
    strFileName = Left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    ' Set up the data structure before you call the function
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hwnd
        .strFilter = Filter
        .nFilterIndex = FilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .Flags = Flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        ' Didn't think most people would want to deal with
        ' these options.
        .hInstance = 0
        '.strCustomFilter = ""
        '.nMaxCustFilter = 0
        .lpfnHook = 0
        'New for NT 4.0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    ' This will pass the desired data structure to the
    ' Windows API, which will in turn it uses to display
    ' the Open/Save As Dialog.
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
    Else
        fResult = aht_apiGetSaveFileName(OFN)
    End If

    ' The function call filled in the strFileTitle member
    ' of the structure. You'll have to write special code
    ' to retrieve that if you're interested.
    If fResult Then
        ' You might care to check the Flags member of the
        ' structure to get information about the chosen file.
        ' In this example, if you bothered to pass in a
        ' value for Flags, we'll fill it in with the outgoing
        ' Flags value.
        If Not IsMissing(Flags) Then Flags = OFN.Flags
        If Flags And ahtOFN_ALLOWMULTISELECT Then
            ' Return the full array.
            Dim items As Variant
            Dim value As String
            value = OFN.strFile
            ' Get rid of empty items:
            Dim i As Integer
            For i = Len(value) To 1 Step -1
              If Mid$(value, i, 1) <> Chr$(0) Then
                Exit For
              End If
            Next i
            value = Mid(value, 1, i)

            ' Break the list up at null characters:
            items = Split(value, Chr(0))

            ' Loop through the items in the "array",
            ' and build full file names:
            Dim numItems As Integer
            Dim result() As String

            numItems = UBound(items) + 1
            If numItems > 1 Then
                ReDim result(0 To numItems - 2)
                For i = 1 To numItems - 1
                    result(i - 1) = FixPath(items(0)) & items(i)
                Next i
                ahtCommonFileOpenSave = result
            Else
                ' If you only select a single item,
                ' Windows just places it in item 0.
                ahtCommonFileOpenSave = items(0)
            End If
        Else
            ahtCommonFileOpenSave = TrimNull(OFN.strFile)
        End If
    Else
        ahtCommonFileOpenSave = vbNullString
    End If
End Function
Public Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String
    ' Tack a new chunk onto the file filter.
    ' That is, take the old value, stick onto it the description,
    ' (like "Databases"), a null character, the skeleton
    ' (like "*.mdb;*.mda") and a final null character.

    If IsMissing(varItem) Then varItem = "*.*"
    ahtAddFilterItem = strFilter & _
                strDescription & vbNullChar & _
                varItem & vbNullChar
End Function
Public Function TrimNull(ByVal strItem As String) As String
    Dim intPos As Integer

    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function
Private Function FixPath(ByVal path As String) As String
    If Right$(path, 1) <> "\" Then
        FixPath = path & "\"
    Else
        FixPath = path
    End If
End Function
Public Function getWordDoc() As String
    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant

    ' Specify that the chosen file must already exist,
    ' don't change directories when you're done
    ' Also, don't bother displaying
    ' the read-only box. It'll only confuse people.
    lngFlags = ahtOFN_FILEMUSTEXIST Or _
                ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
    
    ' Define the filter string and allocate space in the "c"
    ' string Duplicate this line with changes as necessary for
    ' more file templates.
     strFilter = ahtAddFilterItem(strFilter, _
                "WORD (*.doc)", "*.doc;*.docx")

    ' Now actually call to get the file name.

    varFileName = ahtCommonFileOpenSave( _
                    OpenFile:=True, _
                    InitialDir:="C:\", _
                    Filter:=strFilter, _
                    Flags:=lngFlags, _
                    DialogTitle:="Get Word Doc")
    If Not IsNull(varFileName) Then
        varFileName = TrimNull(varFileName)
    End If
    getWordDoc = varFileName
End Function

Sorry for the confusion. Now back to trying this in a report

 

[billlagr]

Thatnks guys, I'll give it a go today and let you know what happens!