Open Embeded Word files and save them out

[mistux]

I am trying to do the following:

1. Loop through a table of embeded Word docs
2. Open each one
3. Save it as a file
4. Close the file
5. Loop to the next one

Here is my looping and opening code that is not working.


Code
-------------------
Dim rst As New ADODB.Recordset
Dim strTableName As String
Dim ctl As Control

strTableName = "T_EmbededDocs"

Set rst = CurrentDb.OpenRecordset(strTableName)

Do While Not rst.EOF
Set ctl = rst.Fields("DocEmbeded") '.Value
With ctl
.Verb = acOLEVerbShow
' Activate object.
.Action = acOLEActivate
End With
rst.MoveNext
Loop

-------------------


I get an Object 424 required, then a type 13 mismatch.

My questions are these?
1. Is my loop correct?
2. Am I oepning the Word file correctly? Am I setting the contro
correctly?
3. Any ideas on how to save the file out passing the name to save

 

[John Nurick]

As far as I know the standard way of doing this is by using a form with
a BoundObjectFrame control bound to the OLE field. You then write code
that uses the Verb and Action properties of the control (Fields don't
have these properties). See http://support.microsoft.com/?id=132003 for
sample code that exports a single Word document; after that it's just a
matter of adding a loop that moves the form to the next record
(Docmd.RunCommand acCmdRecordsGoToNext, maybe) and starts again.

 

[mistux]

I am getting closer. I could not find a way to open the embeded fil
without a form being open (still want to do it just in code and
recordset).

What I have now is a form with one button on it that runs this code.
But it stops because it sayd there is no document open. I think I hav
to somehow set focus to the Word application but don't know how.

Code
-------------------

Dim ctl As Control
Dim strWordCaption As String


Set ctl = Me!OLE_DocEmbeded

With ctl
.Verb = acOLEVerbOpen
.Action = acOLEActivate
End With

'Make sure that Word has the focus
Dim objWord As Word.Application 'Need to go to Tools->References->MS Word 8.0 Object and click it or you get compile error about it not being defiend.
Dim SaveFile As String

SaveFile = "c:\test.doc" '**This is what we will save as

MsgBox ActiveDocument.ActiveWindow.Caption **This always says the name of the Access form with the button, needs to say Word I think***

Set objWord = CreateObject("Word.Application")
With objWord
.ActiveDocument.SaveAs SaveFile 'Saves File
End With

'Release the object variable.
Set objWord = Nothing

-------------------

 

[mistux]

Here is the final way I exported my embeded docs. I could not find
way to make it completely automatic but had to put a button on a for
and click on it for every record, but at least it was only one click.

Thanks to all who helped.

Dim NewObject As Object
Dim NewDoc As String
Dim DocPath As String
Dim strMySQL As String

'Name to save
Dim strNewName As String
Dim x As Integer

x = DCount("[SetupID]", "T_SetupSheetDocs", "SetupID=" & Me.SetupID)

strNewName = IIf(x = 0, 1, x + 1)

' Name of the new document to create.
NewDoc = Me.SetupID & "_" & strNewName ' "TEST.DOC"

' Where to store the new document.
' DefaultDir$(9) returns the Word directory path.
' See DefaultDir$() in Word's on-line help for more options.
' Note: The "$" is not used when calling DefaultDir via
' OLE Automation.
'DocPath
Me!MyOle.Object.Application.WordBasic.DefaultDir(9)
DocPath = DLookup("FileSaveDirectory", "T_Preferences")

' Copies the embedded object to Clipboard.
Me!MyOle.Verb = 0
Me!MyOle.Action = 7
Me!MyOle.Object.Application.WordBasic.EditSelectAll
Me!MyOle.Object.Application.WordBasic.EditCopy
Me!MyOle.Action = 9
DoEvents

' Creates a new document and pastes Clipboard contents.
' Saves the document in the Word directory and closes the
' document.
Set NewObject = CreateObject("Word.Basic")
NewObject.FileNew
NewObject.EditPaste
NewObject.FileSaveAs DocPath & "\" & NewDoc
NewObject.FileClose

' Frees the memory used by the objects.
Set NewObject = Nothing

DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO T_SetupSheetDocs (SetupID, Description
SetupDocNumber) Values(" & Me.SetupID & ", '" & Me.DocDescrption & "'
" & strNewName & ")"
DoCmd.SetWarnings True
MsgBox DocPath & "\" & NewDoc & " was created successfully.