Hi I have some code which i am trying to get to work. i is used to transfer data from a query to a word template. Any suggestions (i am not very good at VBA as you can probabily tell by my code):
Private Sub cmdPrintReport_Click()
Dim appWord As Word.Application
Dim doc As Word.Document
Dim rst As ADODB.Recordset
Dim strSQL As String
Dim strDate As String
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If Err = 429 Then
Set appWord = New Word.Application
Err = 0
End If
With appWord
Set doc = .Documents(DOC_NAME)
If Err = 0 Then
If MsgBox("Do you want to save the current document" _
& "before updating the data?", vbYesNo) = vbYes Then
.Dialogs(wdDialogFileSaveAs).Show
End If
doc.Close False
End If
On Error GoTo ErrorHandler
Set doc = .Documents.Open(DOC_PATH & DOC_NAME, , True)
If Not IsNull(Me!ReportsTo) Then
strSQL = "SELECT [ProjectName] AS ITSQFProName FROM " _
& "qryITSQFSubmission WHERE [ProjectName]=" & Nz(Me!Date)
rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly
If Not rst.EOF Then
strDate = Nz(rst.Fields(0).Value)
rst.Close
End If
End If
With doc
.FormFields("ITSQFDocName").Result = Nz(Me!ITSQFDocumentName)
.FormFields("ITSQFServDes").Result = Nz(Me!ProjectServiceDesigner)
.FormFields("ITSQFProName").Result = Nz(Me!ProjectName)
.FormFields("ITSQFPAR").Result = Nz(Me!ProjectPAR)
End With
Set rst = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Sub
ErrorHandler:
MsgBox Err & Err.Description
End Sub
Private Sub cmdPrintReport_Click()
Dim appWord As Word.Application
Dim doc As Word.Document
Dim rst As ADODB.Recordset
Dim strSQL As String
Dim strDate As String
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If Err = 429 Then
Set appWord = New Word.Application
Err = 0
End If
With appWord
Set doc = .Documents(DOC_NAME)
If Err = 0 Then
If MsgBox("Do you want to save the current document" _
& "before updating the data?", vbYesNo) = vbYes Then
.Dialogs(wdDialogFileSaveAs).Show
End If
doc.Close False
End If
On Error GoTo ErrorHandler
Set doc = .Documents.Open(DOC_PATH & DOC_NAME, , True)
If Not IsNull(Me!ReportsTo) Then
strSQL = "SELECT [ProjectName] AS ITSQFProName FROM " _
& "qryITSQFSubmission WHERE [ProjectName]=" & Nz(Me!Date)
rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly
If Not rst.EOF Then
strDate = Nz(rst.Fields(0).Value)
rst.Close
End If
End If
With doc
.FormFields("ITSQFDocName").Result = Nz(Me!ITSQFDocumentName)
.FormFields("ITSQFServDes").Result = Nz(Me!ProjectServiceDesigner)
.FormFields("ITSQFProName").Result = Nz(Me!ProjectName)
.FormFields("ITSQFPAR").Result = Nz(Me!ProjectPAR)
End With
Set rst = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Sub
ErrorHandler:
MsgBox Err & Err.Description
End Sub