How can get Access to work with 2 Word Documents at the same time?

[newboy18]

Please help, I have a VBA routine in Access that opens a
Word doc from Access, but now I want to open 2 documents
at the same time. How do I set 2 variables so that I can
activate one, then switch and activate the other?

Public Const WordDot As String = "c:\Test.dot"

Dim objWord As Word.Application
Set objWord = CreateObject("Word.Application")
Documents.Open WordDot, , ReadOnly
ActiveDocument.Select
ActiveDocument.Close (wdDoNotSaveChanges)
objWord.Quit
Set objWord = Nothing

I thought I could change my code to this but it wont
accept "objWord.Open" in the 4th line: When I tried to run
it, it gives the error: "Method or data member not found"
Also I don't know if I need line 2

Dim objWord As Word.Application
Set objWord = CreateObject("Word.Application")
Dim docType1 As Document, docType2 As Document
Set docType1 = objWord.Open(WordDot, , ReadOnly)
Set docType2 = objWord.Open(WordDot, , ReadOnly)
docType1.Select

 

[Dan Artuso]

Hi,
Always use the Object Browser to find out info on an object model.
There is no Open method of the application object.
You have to use the Open method of the Documents class.

Set docType1 = objWord.Documents.Open(WordDot, , ReadOnly)

 

[newboy18]

Maybe I am trying to do too much but the idea was:
I have a database query of contacts. Email Address, Name
and Type and is sorted in that order.
The routine is supposed to be run once a year and send
contacts an application form for each Type based upon 1 of
7 different Word Templates either by email or post.
1/. Select the template associated to the Type and edit it.
2/. If the contact does not have an email address then
save it in a folder to be printed at the end, else save it
in another folder ready to be attached to an email
3/. If the next contact has a different email address then
send the saved attachments to the last email contact,
clear the folder and save this attachment
4/. At the same time keep a text log

This means I have to write VBA in Access to access emails
in Outlook, using 7 Templates in Word and keep a Text log.
The 2 main problems are when to set things up as Public
and addressing applications explicitly

I have copied the routine below, if you can help that
would be great, if not I will understand, it has become a
complete mess.

Option Compare Database
Public Const DocsMail As String = "C:\DocsMail\"
Public Const DocsEmail As String = "C:\DocsEmail\"
Public Const WordDot As String = "c:\Test.dot"
Public Const WordDot2 As String = "c:\Test2.dot"
Public Const XlLog As String = "c:\Log.xls"
Public strName As String
Public strMail As String
Public strEmail As String
Public strEmail2 As String
Public strType As String
Public Const strMStar As String = DocsMail & "*.doc"
Public Const strEStar As String = DocsEmail & "*.doc"
Public intXl As Integer
Public Const TxtFileName As String = "c:\MailLog.txt"
Public intFileNo As Integer
Public olApp As Outlook.Application '####Need to add MS
Outlook reference #####
Public objWord As Word.Application
Public docType1 As Word.Document
Public docType2 As Word.Document
Sub Start_Proc()

intFileNo = FreeFile
Open TxtFileName For Output As #intFileNo
Set olApp = New Outlook.Application
Dim fs As Object 'Do folders exist, if not, create them
and delete any docs
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.folderexists(DocsMail) Then
Else: MkDir DocsMail
End If
If fs.folderexists(DocsEmail) Then
Else: MkDir (DocsEmail)
End If
Set fs = Nothing
If Dir(strMStar) <> "" Then Kill strMStar
If Dir(strEStar) <> "" Then Kill strEStar

Set objWord = CreateObject("Word.Application")
'objWord.ScreenUpdating = False
Set docType1 = objWord.Documents.Open(WordDot, , ReadOnly)
Set docType2 = objWord.Documents.Open(WordDot2, , ReadOnly)
docType1.Activate

Dim cnn As New ADODB.Connection, rst As New ADODB.Recordset
frmStatus.Show
frmStatus.lblStatus.Caption = "Starting process, Please
wait..."
frmStatus.Repaint

Set cnn = CurrentProject.Connection
rst.Open ("QryEmailName"), cnn, adOpenStatic,
adLockPessimistic
Do Until rst.EOF
strName = rst.Fields("Name")
strType = rst.Fields("Type")
Select Case strType
Case Is = "Type 1"
' select template 1
Case Is = "Type 2"
' select template 2
Case Else
' give error ? ? ?
End Select
docType1.Select
Selection.HomeKey Unit:=wdStory 'Edit template
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.TypeText Text:=strName

Selection.EndKey Unit:=wdStory
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.TypeText Text:=strName

Selection.HomeKey Unit:=wdLine
Selection.MoveUp Unit:=wdLine, Count:=5
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.TypeText Text:=strName

Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCell, Count:=2
Selection.HomeKey Unit:=wdLine

If rst.Fields("EmailAddress") <> "" Then 'Send email
from here
strEmail = rst.Fields("EmailAddress")
frmStatus.lblStatus.Caption = "Emailing " &
strEmail
frmStatus.Repaint
If strEmail = strEmail2 Then 'Add email to folder
ready to be sent
SaveEmail
Else 'New contact so send existing email and kill
If Dir(strEStar) <> "" Then 'If there are
docs, send them
EmailDoc
Kill strEStar ' Del *.doc
End If 'Save email att
SaveEmail
strEmail2 = strEmail
End If
Else 'Save doc from here
strMail = DocsMail & strName & strType & ".doc"
frmStatus.lblStatus.Caption = "Printing " & strMail
frmStatus.Repaint
SaveDoc
End If
rst.MoveNext
Loop
ActiveDocument.Close (wdDoNotSaveChanges)
If Dir(strEStar) <> "" Then 'If there are attachments
left, send them
EmailDoc
Kill strEStar ' Del *.doc
End If
Unload frmStatus

Set docType1 = Nothing
Set docType2 = Nothing
'objWord.ScreenUpdating = True
objWord.Quit
Set objWord = Nothing
cnn.Close
Set cnn = Nothing
Close #intFileNo
Set olApp = Nothing

End Sub

Sub SaveEmail()
Stop
ActiveDocument.SaveAs DocsEmail & strName & strType
& ".doc"
ActiveDocument.Close (wdDoNotSaveChanges)
Documents.Open WordDot, , ReadOnly ' may not need ? ? ?
ActiveDocument.Select ' may not need ? ? ?
Print #intFileNo, _
Chr$(34) & strType & Chr$(34) & Chr$(9) _
& Chr$(34) & "emailed to" & Chr$(34) & Chr$(9) _
& Chr$(34) & strEmail & Chr$(34)
End Sub
Sub SaveDoc()

ActiveDocument.SaveAs strMail
'ActiveDocument.PrintOut
ActiveDocument.Close (wdDoNotSaveChanges)
Documents.Open WordDot, , ReadOnly ' may not need ? ? ?
ActiveDocument.Select ' may not need ? ? ?
Print #intFileNo, _
Chr$(34) & strType & Chr$(34) & Chr$(9) _
& Chr$(34) & "printed to" & Chr$(34) & Chr$(9) _
& Chr$(34) & strName & Chr$(34)
End Sub
Sub EmailDoc()

Dim DocstoEmail As String
DocstoEmail = Dir(strEStar)
Dim olMail As MailItem
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = strEmail2
.Subject = "Send email to " & strEmail2
Do While DocstoEmail <> ""
.Attachments.Add DocsEmail & DocstoEmail
DocstoEmail = Dir
Loop
.Send
End With
Set olMail = Nothing
End Sub

 

[Dan Artuso]

Hi,
I haven't done any Word automation so I don't think I'm the best person
to help you out.
What about posting this in microsoft.public.word.vba.general?

 

[Dirk Goldgar]

Thanks Dan,
I dont understand, if I do the following in Excel it works
but it wont work in Access, it says "docType.Select" is
invalid

Dim WordDot As String
Dim WordDot2 As String
WordDot = "C:\Test.dot"
WordDot2 = "C:\Test2.dot"
Dim objWord As Word.Application
Set objWord = CreateObject("Word.Application")
Dim docType As Document
Dim docType2 As Document
Set docType = objWord.Documents.Open(WordDot, , ReadOnly)
Set docType2 = objWord.Documents.Open(WordDot2, , ReadOnly)
docType.Select
docType2.Select
docType.Close wdDoNotSaveChanges
docType2.Close wdDoNotSaveChanges
Set docType = Nothing
Set docType2 = Nothing
objWord.Quit
Set objWord = Nothing

This specific error probably has to do with the fact that there's a
Document object in DAO as well, so if you have a reference to the DAO
object library that is above the reference to the Word object library in
your list of project references, your declarations:

Dim docType As Document
Dim docType2 As Document

will be interpreted as declaring DAO Document object, which don't have a
Select method. Try changing your declarations to

Dim docType As Word.Document
Dim docType2 As Word.Document

and see if the error disappears.

I've very little experience with automating Word, though, so I can't
give any further advice on how to accomplish your goal.