strSQL = "SELECT [id] FROM quotation WHERE substring(reference ,3 ,len(reference)) = " & jobno & " AND version = " & ver

strSQL = "SELECT [id] FROM quotation WHERE Right(reference, 6)  = " & jobno & " AND version = " & ver & " ORDER BY [createdDate]

Private Function descriptions(ByVal x As Double, y As Double, w As Double, h        As Double, jobno As String, ver As String)
'On Error GoTo ex
ActiveDocument.ReferencePoint = cdrTopLeft
Dim objConn As New ADODB.Connection
Dim objRS As New ADODB.Recordset
Dim objCmd As New ADODB.Command



Dim strSQL As String, path As String
Dim bol As Boolean
Dim recordsCounter As Long, a As Long, b As Long
Dim fieldvalue As Variant
Dim QR As String
Dim dat As Variant
Dim FULLID As String
Dim i As Long, j As Long, k As Long


'CONNECT TO SERVER AND DB
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


With objConn
            .Provider = "SQLOLEDB.1;Password=xxxxxxxxxxxxxxxxxxx;Persist Security Info=True;User ID=xxxxxxxxxxxxxxxxxxx;Initial Catalog=xxxxxxxxxx;"
            .ConnectionString = "Data Source=xxxxxxxxxxxxxxxxxxx;"
    .Open
End With

If objConn.State <> 1 Then MsgBox "You were unable to connect to the database!", vbInformation

'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

strSQL = "SELECT [id] FROM quotation WHERE substring(reference ,3 ,len(reference)) = " & jobno & " AND version = " & ver

'strSQL = "SELECT [id] FROM quotation WHERE Right(reference, 6)  = " & jobno & " AND version = " & ver & " ORDER BY [createdDate]

'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

objRS.Open strSQL, objConn, adOpenKeyset, adLockOptimistic
QR = objRS.Fields(0).Value
FULLID = objRS.Fields(1).Value
MsgBox FULLID

'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
strSQL = "SELECT [itemId], [quantity], [description] FROM quotationitems WHERE quotationid = " & [QR] & " ORDER BY [itemId];"
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

objRS.Close
objRS.Open strSQL, objConn, adOpenKeyset, adLockOptimistic




'RETRIEVE DESCRIPTIONS
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


Dim DX As Double, DY As Double, DW As Double, DH As Double
Dim drx As Double, dry As Double, drw As Double, drh As Double
Dim DESCRIP As New ShapeRange
Dim s1 As Shape
Dim descriprange As Shape
Dim DLINE As String

Dim Desc As String, itm As String, quantity As String

DX = x + (w * 0.005)
DY = y + (h * 0.001)

Do While Not objRS.EOF

        If objRS.Fields(0).Value <> -1 Then itm = Chr(64 + objRS.Fields(0).Value)
        If objRS.Fields(1).Value <> -1 Then quantity = objRS.Fields(1)
        If objRS.Fields(2).Value <> -1 Then Desc = objRS.Fields(2)
        DLINE = "ITEM " & replace(itm, vbCr, "  ") & "   Qty:  " & quantity & "   " & Chr(13) & Desc



        Set s1 = ActiveLayer.FindShape("DESCRIPTIONENTRYPOINT")
        s1.Duplicate
        s1.TEXT.Story = DLINE
        s1.TEXT.Story = replace(s1.TEXT.Story, vbCr & vbCr, "")
        s1.TEXT.Story = replace(s1.TEXT.Story, "ITEM ", vbCr & vbCr & "ITEM   ")
        DESCRIP.Add s1
        DY = DY - (s1.SizeHeight * 1.1)
        s1.ObjectData("Name") = "DESCRIPTION-PARAGRAPH"


    recordsCounter = recordsCounter + 1
    objRS.MoveNext

  Loop
  objRS.Close

    Dim TRS As ShapeRange
    Set TRS = ActiveLayer.FindShapes("DESCRIPTIONENTRYPOINT")
    TRS.Delete

'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


'POSITION + SCALE DESCRIPTION TEXT TO SUIT TEMPLATE
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

DESCRIP.GetBoundingBox DX, DY, DW, DH, False
DESCRIP.CreateSelection
Set DESCRIP = ActiveSelectionRange.ReverseRange

Set descriprange = ActiveLayer.FindShape("DESCRANGE")
descriprange.GetBoundingBox drx, dry, drw, drh, False


 Dim TXT2 As Shape

 For Each TXT2 In DESCRIP

    TXT2.TEXT.ConvertToParagraph
    TXT2.ObjectData("Name") = "DESCRIPTION-PARAGRAPH"

Next TXT2


DESCRIP.Combine



DESCRIP.SetSize drw, drh
DESCRIP.SetPosition drx, dry + drh


FINE2:



'TIDY GROUPS ADD ADD DESCRIPTION TO TEMPLATE GROUP
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Dim FINDTEMP As Shape
Set FINDTEMP = ActivePage.FindShape(name:="template")
Dim regrouped As Shape
Dim regrouper As ShapeRange
Set regrouper = FINDTEMP.UngroupAllEx
DESCRIP.CreateSelection
regrouper.Add ActiveSelection

Set regrouped = regrouper.Group
regrouped.ObjectData("Name") = "template"
regrouper.RemoveAll




Set objCmd = Nothing
Set objRS = Nothing
Set objConn = Nothing
ex:
End Function