Hi there-
I am beginning to move a database from 2003 to 2010. The code below worked in 2003 but now I am being prompted to save the Word doc. Could anyone tell me what I am doing wrong? Thank you!
Elizabeth
Private Sub CallMergeToWord(strcltnum As String) 'bring plan num over from Loop procedure
On Error GoTo Err_CallMergeToWord
Dim strSQL As String
Dim strDirDoc As String 'merged docs directory
Dim strDirDot As String '.dot template directory
Dim strLtrDot As String 'The .dot template
Dim strLtrDoc As String 'The merged word doc
Const wdSendToNewDocument = 0
Const wdDoNotSaveChanges = 0
strDirDot = "\\server2\masters\.....
strLtrDot = "FeeLetterTEST.dot"
strDirDoc = "\\server2\masters\.....
strLtrDoc = strcltnum & "_FeeLetter.doc"
Dim obWord As Object
Dim doc As Object
'First I try to use their opened Word application, but if it isn't already opened I handle the error in line
On Error Resume Next
Set obWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
'If got this error it means that there was not an instance of Word open already so...
Set obWord = CreateObject("Word.Application")
End If
obWord.Visible = True 'goes after set obword and before opening template
'reset error handler
On Error GoTo Err_CallMergeToWord
Set doc = obWord.Documents.Add(strDirDot & strLtrDot)
'open merge datasource
doc.MailMerge.OpenDataSource _
Name:="\\server2\masters\.....\testcustom2010.accdb", _
LinkToSource:=True, _
SQLStatement:="SELECT * from [FEELETTER] where cltnum = '" & strcltnum & "'"
'execute mailmerge
doc.MailMerge.Destination = wdSendToNewDocument
doc.MailMerge.Execute
doc.close wdDoNotSaveChanges
*******************on the line below I get 4198 Command Failed
obWord.ActiveDocument.saveas FileName:=strDirDoc & strLtrDoc, FileFormat:=0 'save the newly created doc.
*******************I've also tried and same thing happens
obWord.ACTIVEDOCUMENT.saveas (strDirDoc & strLtrDoc)
obWord.ActiveDocument.close 'close the newly created doc.
Exit_CallMergeToWord:
Set doc = Nothing
Set obWord = Nothing
Exit Sub
Err_CallMergeToWord:
MsgBox Err.Number & Err.Description
Resume Exit_CallMergeToWord
End Sub
Tidak ada komentar:
Posting Komentar