|
Re: Mail Merge Opp Products table
Posted: 03 Jun 08 3:09 AM
|
I added a new case the "SLX Mail Merge OnCustomFieldName" plugin. This example uses some customized opportunity fields and show the discount column only when it's not 0. In the word template use "Insert Special Field" and choose "Custom" and for the "Field Identifier" use the name used in the case switch which is in this case "PRODUCTS_TABLE".
Case "PRODUCTS_TABLE" 'DNL
SumDiscount = 0
Extendedlocal = 0
TotalPrice = 0
TotalListPrice = 0
Set objConn = Application.GetNewConnection
' See if there was discount used otherwise do not show column DISCOUNT
SQL = "Select Sum(DISCOUNT) AS SumDiscount from Opportunity_product where Opportunityid = '" & strOpportunityID & "' "
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open SQL, objConn
SumDiscount = objRS.Fields("SumDiscount").value
objRS.Close
SQL = "SELECT OP.SORT, OP.QUANTITY, OP.PRICE, OP.DISCOUNT, OP.EXTENDEDPRICE, OP.PRODUCTID, OP.NOTES, OP.IDKEY, " _
& "OP.FROM_DATE, OP.TO_DATE, OP.CPUTYPE, OP.ORG_PO, OP.PRICELOCAL, OP.EXTENDEDLOCAL, " _
& "O.EXCHANGERATECODE " _
& "FROM OPPORTUNITY_PRODUCT OP " _
& "INNER JOIN OPPORTUNITY O ON OP.OPPORTUNITYID = O.OPPORTUNITYID " _
& "WHERE OP.OPPORTUNITYID = '" & strOpportunityID & "' ORDER BY OP.SORT"
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open SQL, objConn
if Not (objRS.BOF Or objRS.EOF) then
OppExchangeRateCode = "" & objRS.Fields("EXCHANGERATECODE").value 'DNL
'Print Header in Table
if SumDiscount <> 0 then
oRange.InsertAfter "Unit|Code - Description|Qty|Unit Price (" & OppExchangeRateCode & ")|Discount|Amount (" & OppExchangeRateCode & ")" 'DNL
else
oRange.InsertAfter "Unit|Code - Description|Qty|Unit Price (" & OppExchangeRateCode & ")|Amount (" & OppExchangeRateCode & ")" 'DNL
end if
oRange.InsertParagraphAfter
While Not (objRS.BOF Or objRS.EOF)
PriceLocal = cDbl(NullToZero(objRS.Fields("PRICELOCAL").Value)) 'DNL
ExtendedLocal = cDbl(NullToZero(objRS.Fields("EXTENDEDLOCAL").Value)) 'DNL
dblDiscount = NullToZero(objRS.Fields("DISCOUNT").Value) 'DNL
intSort = NullToZero(objRS.Fields("SORT").value) 'DNL
dblQuantity = NullToZero(objRS.Fields("QUANTITY").Value) 'DNL
strCPUType = "" & objRS.Fields("CPUTYPE").value 'DNL
strNotes = "" & ReplaceNewLine( "" & objRS.Fields("NOTES").value ) 'DNL
strOrgPO = "" & ReplaceNewLine( "" & objRS.Fields("ORG_PO").value ) 'DNL
dtFrom = FormatDateTime(CheckForNullDate(objRS.Fields("FROM_DATE").value), 1) 'DNL
dtTo = FormatDateTime(CheckForNullDate(objRS.Fields("TO_DATE").value), 1) 'DNL
If not (IsNull(objRS.Fields("GHS_IDKEY").value) or objRS.Fields("IDKEY").value = "") Then
strIDkey = "ID KEY: " & objRS.Fields("IDKEY").value & " " 'DNL
Else
strIDkey = "" 'DNL
End If
If not (IsNull(objRS.Fields("ORG_PO").value) or objRS.Fields("ORG_PO").value = "") Then
strOrgPO = "Original PO: " & objRS.Fields("ORG_PO").value & " " 'DNL
Else
strOrgPO = "" 'DNL
End If
TotalPrice = TotalPrice + ExtendedLocal 'DNL
SQL = "Select ACTUALID, DESCRIPTION from Product where Productid = '" & objRS.Fields("PRODUCTID").value & "' "
Set productRS = CreateObject("ADODB.Recordset")
productRS.Open SQL, objConn
if Not (productRS.BOF Or productRS.EOF) then
ProductCode = "" & productRS.Fields("ACTUALID").value 'DNL
ProductDescription = replace("" & productRS.Fields("DESCRIPTION").value,"XXX",strCPUType) 'DNL
' ProductDescription = "Test" 'DNL
if left(ProductCode, 1) = "@" then
strMaint = "Maintenance to run from " & dtFrom & " to " & dtTo & " " 'DNL
else
strMaint = ""
end if
else
MsgBox "ProductID not Found. The next popup message is a system message to stop mailmerge. You do not need to contact the administrator."
strResultError = Application.Translator.Localize("ProductID not Found.")
Err.Number = 1000
Err.Description = strResultError
end if
productRS.Close
oRange.InsertAfter intSort & "|" & ProductCode & " - " & ProductDescription & " " 'DNL
oRange.InsertAfter strIDkey & strMaint & strOrgPO & strNotes 'DNL
oRange.InsertAfter "|" & dblQuantity & "|" & formatnumber(PriceLocal, 2) 'DNL
if SumDiscount <> 0 then
oRange.InsertAfter "|" & dblDiscount * 100 & "%" 'DNL
end if
oRange.InsertAfter "|" & formatnumber(ExtendedLocal, 2) 'DNL
oRange.InsertParagraphAfter 'DNL
objRS.MoveNext
Wend
if SumDiscount <> 0 then
oRange.InsertAfter "||||TOTAL|" & formatnumber(TotalPrice,2) 'DNL
else
oRange.InsertAfter "|||TOTAL|" & formatnumber(TotalPrice,2) 'DNL
end if
Set oTable = oRange.ConvertToTable("|", , , ,23, True, True, True, False, True, _
True, False, False, True, wdAutoFitContent, wdWord9TableBehavior)
' Align table
For i = 0 To oTable.Rows.Count - 1 step 1
oTable.Cell(i, 1).Width = 30
oTable.Cell(i, 2).Width = 280
oTable.Cell(i, 3).Width = 30
oTable.Cell(i, 4).Width = 60
oTable.Cell(i, 3).Range.ParagraphFormat.Alignment = 1 'Qty centered
oTable.Cell(i, 4).Range.ParagraphFormat.Alignment = 2 ' listprice right aligned
if SumDiscount <> 0 then
oTable.Cell(i, 5).Width = 50
oTable.Cell(i, 6).Width = 60
oTable.Cell(i, 5).Range.ParagraphFormat.Alignment = 1 'Discount centered
oTable.Cell(i, 6).Range.ParagraphFormat.Alignment = 2 'Your price right aligned
else
oTable.Cell(i, 5).Width = 60
oTable.Cell(i, 5).Range.ParagraphFormat.Alignment = 2 'Your price right aligned
end if
Next
oTable.Cell(oTable.Rows.Count, 1).Width = 30
oTable.Cell(oTable.Rows.Count, 2).Width = 280
oTable.Cell(oTable.Rows.Count, 3).Width = 30
oTable.Cell(oTable.Rows.Count, 4).Width = 60
if SumDiscount <> 0 then
oTable.Cell(oTable.Rows.Count, 5).Width = 50
oTable.Cell(oTable.Rows.Count, 6).Width = 60
oTable.Cell(oTable.Rows.Count, 5).Range.ParagraphFormat.Alignment = 2 'Total right aligned
oTable.Cell(oTable.Rows.Count, 6).Range.ParagraphFormat.Alignment = 2 'Total price right aligned
else
oTable.Cell(oTable.Rows.Count, 5).Width = 60
oTable.Cell(oTable.Rows.Count, 4).Range.ParagraphFormat.Alignment = 2 'Total right aligned
oTable.Cell(oTable.Rows.Count, 5).Range.ParagraphFormat.Alignment = 2 'Total price right aligned
end if
else
MsgBox "No opportunity products. The next popup message is a system message to stop mailmerge. You do not need to contact the administrator."
strResultError = Application.Translator.Localize("No opportunity products.")
Err.Number = 1000
Err.Description = strResultError
end if
objRS.Close
set productRS = Nothing
set objRS = Nothing
set objConn = Nothing
|
|
|