The work around was for me to create a MS Word Template which is stored as a document within a AwareIM table. The template uses bookmarks to mark the areas to update with database fields. Also, I use an existing table skeleton within the template to paste the rows preformatted with the table characteristics.
When the user clicks on a button on the form within AwareIM, I launch a process that writes out some parameter fields to one of the AwareIM tables. Within the VBA I call a stored procedure that is passed the user via an environment variable. This gives me a way of knowing exactly which record from the table needs to be retrieved from the AwareIM table/database.
Here is the VBA code if anyone is interested.
Private conn As ADODB.Connection
Private cmd As ADODB.Command
Private rsData As ADODB.Recordset
Private rowTotal As Integer 'total number of records returned by datareader
Private rowEnd As Integer 'last row of data
Private actLabor As Currency
Private actTotal As Currency
Private rsTotalRow As Integer
Private objDoc As Document
'Private objTemp As Document
Private Sub Connect()
Dim sConnect As String
Dim sSQL As String
On Error GoTo ErrHandler
sConnect = "Provider=MSDASQL.1;DRIVER=SQL Server;SERVER=TTCDB;Persist Security Info=False;Database=BASDBTEST;Initial Catalog=BASDBTEST;UID=SalesCRM;password=money"
Application.StatusBar = "Attempting to connect...."
Set conn = New ADODB.Connection
conn.ConnectionString = sConnect
conn.ConnectionTimeout = 300
conn.CommandTimeout = 300
conn.CursorLocation = adUseClient
conn.Open
If conn.State = 1 Then
Application.StatusBar = ""
Else
Application.StatusBar = "Unable to connect to Database!"
End If
Exit Sub
ErrHandler:
MsgBox Err.Description, vbOKOnly, "Connect"
End Sub
Private Sub CloseConnection()
If conn.State <> 0 Then conn.Close
Set conn = Nothing
Set cmd = Nothing
Set rsData = Nothing
End Sub
Private Sub GetData()
On Error GoTo DataErr
Set rsData = New ADODB.Recordset
If conn.State = 1 Then
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = conn
' .CommandType = adCmdText
.CommandType = adCmdStoredProc
.CommandText = "SalesCRM_Quote"
.Parameters(1).Value = (Environ$("Username"))
Set rsData = .Execute
End With
Set cmd = Nothing
If rsData.RecordCount > 1 Then
rsTotalRow = rsData.RecordCount
Else
rsTotalRow = 0
End If
End If
Exit Sub
DataErr:
MsgBox Err.Description, vbOKOnly, "SalesCRM_Quote"
End Sub
Private Sub Document_New()
Dim sEmployeeName As String
Dim sContactSal As String
Dim sQuote_Number As String
Dim sWorkingDirectory As String
Connect
GetData
If rsTotalRow > 0 Then
'Set objDoc = Documents.Add(sTemplatepath & objTemp.Name)
Set objDoc = ActiveDocument
sQuote_Number = NoNulls("Quote_Number")
sWorkingDirectory = NoNulls("Working_Directory")
'Set Bookmarked Data
SetBookmark objDoc, "Quote_Date", FormatDateTime(Date, vbLongDate)
SetBookmark objDoc, "Quote_Number", NoNulls("Quote_Number")
SetBookmark objDoc, "Contact_Name", NoNulls("Contact_FullName")
SetBookmark objDoc, "Company_Name", NoNulls("Company_Name")
SetBookmark objDoc, "Contact_Phone", NoNulls("Contact_Phone")
SetBookmark objDoc, "Contact_Email_Address", NoNulls("Contact_Email_Address")
If NoNulls("Contact_Salutation") = "" Then
sContactSal = NoNulls("Contact_First_Name")
Else
sContactSal = NoNulls("Contact_Salutation") & " " & NoNulls("Contact_Last_Name")
End If
SetBookmark objDoc, "Contact_Salutation", sContactSal
SetBookmark objDoc, "Terms", NoNulls("Terms")
sEmployeeName = NoNulls("Employee_First_Name") & " " & NoNulls("Employee_Last_Name")
SetBookmark objDoc, "Employee_Name", sEmployeeName
SetBookmark objDoc, "Employee_Phone_Number", NoNulls("Employee_Phone_Number")
SetBookmark objDoc, "Employee_Email_Address", NoNulls("Employee_Email_Address")
SetBookmark objDoc, "Employee_Name_Signature", sEmployeeName
SetBookmark objDoc, "Employee_Title", NoNulls("Employee_Title")
'Populate Table Data
PopulateTable objDoc
objDoc.SaveAs (sWorkingDirectory & "\" & sQuote_Number)
End If
End Sub
Private Function NoNulls(sFieldName As String) As String
If IsNull(rsData(sFieldName)) Then
NoNulls = ""
Else
NoNulls = rsData(sFieldName)
End If
End Function
Private Sub SetBookmark(objDoc As Document, sBookmark As String, sValue As String)
If objDoc.Bookmarks.Exists(sBookmark) Then
objDoc.Bookmarks(sBookmark).Range.Text = sValue
End If
End Sub
Private Sub PopulateTable(objDoc As Document)
Dim objTable As Table
Dim lCurrentRow As Integer
Dim lTotal As Long
Dim lSubTotal As Long
Dim sDescription As String
Dim bItemCnt As Boolean
Dim iItemCnt As Integer
Dim iLinesCnt As Integer
Set objTable = objDoc.Tables(1)
lCurrentRow = 2 ' Start w/second row of table
If NoNulls("Sequence_Product") = "" Then
bItemCnt = True
iItemCnt = 1
End If
Do While Not rsData.EOF
With objTable
If lCurrentRow > 2 Then
.Rows.Add objTable.Rows(lCurrentRow) ' Insert Row into table
End If
If sDescription <> NoNulls("Order_Line_Description") Then
If lCurrentRow > 2 Then
'Need to do sub-Total'
'Merge cells
.Cell(lCurrentRow, 1).Select
Selection.SelectCell
Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
Selection.Cells.Merge
.Rows(lCurrentRow).Shading.Texture = wdTexture10Percent
.Cell(lCurrentRow, 2).Range.Text = FormatCurrency(lSubTotal, 0)
.Cell(lCurrentRos, 1).Range.Text = "Sub-Total"
.Cell(lCurrentRow, 1).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
.Rows.Add objTable.Rows(lCurrentRow + 1) ' Insert Row into table
lCurrentRow = lCurrentRow + 1
lSubTotal = 0
End If
.Rows(lCurrentRow).Cells.Merge
.Rows(lCurrentRow).Shading.Texture = wdTexture20Percent
sDescription = NoNulls("Order_Line_Description")
.Cell(lCurrentRow, 1).Range.Text = sDescription
.Cell(lCurrentRow, 1).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Rows.Add objTable.Rows(lCurrentRow + 1) ' Insert Row into table
lCurrentRow = lCurrentRow + 1
iItemCnt = 1
iLinesCnt = iLinesCnt + 1
End If
If bItemCnt Then
.Cell(lCurrentRow, 1).Range.Text = iItemCnt
iItemCnt = iItemCnt + 1
Else
.Cell(lCurrentRow, 1).Range.Text = NoNulls("Sequence_Product")
End If
.Cell(lCurrentRow, 2).Range.Text = NoNulls("Part_Number")
.Cell(lCurrentRow, 3).Range.Text = NoNulls("Model_Number")
.Cell(lCurrentRow, 4).Range.Text = NoNulls("Description_Long")
.Cell(lCurrentRow, 5).Range.Text = FormatCurrency(NoNulls("Price_Order"), 0)
.Cell(lCurrentRow, 6).Range.Text = NoNulls("Price_Quantity")
.Cell(lCurrentRow, 7).Range.Text = FormatCurrency(NoNulls("Price_Extended"), 0)
End With
lCurrentRow = lCurrentRow + 1
lTotal = lTotal + NoNulls("Price_Extended")
lSubTotal = lSubTotal + NoNulls("Price_Extended")
rsData.MoveNext
Loop
If iLinesCnt > 1 Then
'Merge cells
With objTable
.Cell(lCurrentRow, 1).Select
Selection.SelectCell
Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
Selection.Cells.Merge
.Rows(lCurrentRow).Shading.Texture = wdTexture10Percent
.Cell(lCurrentRow, 2).Range.Text = FormatCurrency(lSubTotal, 0)
.Cell(lCurrentRos, 1).Range.Text = "Sub-Total"
.Cell(lCurrentRow, 1).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
.Rows.Add objTable.Rows(lCurrentRow + 1) ' Insert Row into table
lCurrentRow = lCurrentRow + 1
End With
End If
objTable.Rows(lCurrentRow).Delete
objTable.Cell(lCurrentRow, 2).Range.Text = FormatCurrency(lTotal, 0) ' Put Total in table
End Sub
