Hi, I am using an MSAccess database to automatically merge data into a Word Template, using the code below. Unfortunately, The final "merged" document still links back to the MSaccess database, instead of creating a separate instance of the document. Can anyone help me figure this out?
Code:
Private Sub Copy08Customer_Click()
[DateToday] = Date
[LabelNumber] = "-02"
[LabelName] = "Customer Image"
[LabelFileName] = [ComponentPartNoStripped] & "-08_Customer_CD.doc"
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
If IsNull([-08_Labels_Directory_Location]) Then
MsgBox ("Error: The -08 Directory does not exist.")
Exit Sub
End If
If Not DirExists([-08_Labels_Directory_Location]) Then
MsgBox ("Error: The -08 Directory does not exist.")
Exit Sub
End If
If IsNull([OS Type]) Then
MsgBox ("The Operating system type is not Specified.")
Exit Sub
End If
'If IsNull([Contract Number]) Then
' MsgBox ("The Contract/TAA number is not Specified.")
' Exit Sub
'End If
On Error GoTo ErrorHandler
Dim appWord As Word.Application
Dim docs As Word.Documents
Dim strLetter As String
Dim prps As Object
Dim strDate As String
Dim fso As New Scripting.FileSystemObject
Dim fil As Scripting.file
Dim strTemplate As String
Dim strTemplatePath As String
Dim strTemplateNameAndPath As String
Dim doc As Word.Document
Dim strTitle As String
Dim strPrompt As String
Dim DocPath As String
Dim CurrentDate As String
CurrentDate = Date
Set appWord = GetObject(, "Word.Application")
strTemplatePath = "[URL="file://\\server\WordTemplates"]\\server\WordTemplates[/URL]"
If [Project].Value = "COTS" Then
strLetter = "Template-08_Customer_CD_COTS.dot"
Else
strLetter = "Template-08_Customer_CD.dot"
End If
strTemplateNameAndPath = strTemplatePath & "\" & strLetter
''Debug.Print "Template and path: " & strTemplateNameAndPath
'Set path and filename
[-08_Customer_CD_Filename] = [-08_Labels_Directory_Location] & "\" & [LabelFileName]
DocPath = [-08_Customer_CD_Filename].Value
'Debug.Print "Document Path: " & DocPath
Set docs = appWord.Documents
Set doc = docs.Add(strTemplateNameAndPath)
Set prps = doc.CustomDocumentProperties
With prps
.Item("Project").Value = Nz(Me![Project])
.Item("Component").Value = Nz(Me![Component])
.Item("ComponentPartNoStripped").Value = Nz(Me![ComponentPartNoStripped])
.Item("Revision").Value = Nz(Me![Revision])
.Item("Product").Value = Nz(Me![Product])
.Item("CurrentDate").Value = Nz(Me![CurrentDate])
.Item("PVCS Project Label").Value = Nz(Me![PVCS Project Label])
.Item("CurrentDate").Value = Nz(Me![CurrentDate])
.Item("Contract Number").Value = Nz(Me![Contract Number])
.Item("OS Type").Value = Nz(Me![OS Type])
End With
With appWord
.Visible = False
.Activate
.Selection.WholeStory
.Selection.Fields.Update
.Selection.MoveDown Unit:=wdLine, Count:=1
.WindowState = wdWindowStateMinimize
End With
'Save the document
doc.SaveAs DocPath
'Close the document and clear the variables
docs.Close SaveChanges:=wdDoNotSaveChanges
appWord.Quit
Set docs = Nothing
Set appWord = Nothing
ErrorHandlerExit:
Exit Sub
ErrorHandler:
If Err = 429 Then
'Word is not running; open Word with CreateObject
Set appWord = CreateObject("Word.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End If
End Sub