Its my first post as I've managed to cope with just reading all the existing discussions to fix any problems or learn anything I'm stumped on. However with this problem has me well and truly stumped!
The company I work at saves individual jobs under a job number, this is currently a six digit 207076 number. Basically what I want to do is take those six digits, search a database for that job and pull in all the details(customer and job info) that I might require. Should be pretty simple. Get the file name then just that as a string to search in the relevant field.
Well not really because each job number in the database starts with 2 or 3 characters that represent the estimators initials. Also the length of the job number started at 1000. To illustrate how the entries please so the screen grab below
Firstly I tried a sub string and just stripping the first two characters off:
strSQL = "SELECT [id] FROM quotation WHERE substring(reference ,3 ,len(reference)) = " & jobno & " AND version = " & ver
This only works some times as a few of our estimators have entered their initials with three characters
Secondly I tried using a right command and just comparing with the last 6 digits
strSQL = "SELECT [id] FROM quotation WHERE Right(reference, 6) = " & jobno & " AND version = " & ver & " ORDER BY [createdDate]
Again only works some of the time as if you hit any job in the database with less than 6 digits in its name it crashes.
My Last idea was to reference the Excel library and use the VAL function but I cant seem to get this to work within the SQL statement. I'm really not sure how to fix the issue.
Coreldraw's VBA seems to be extremely flakey with SQL statements; a lot of the things I've read just don't seem to apply which makes it extremely frustrating for learning. I believe I my references to be correct?
Full code below (passwords and database info blanked out)
All crits and help welcome, Thanks
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
Example 1:
strSQL = "SELECT [id] FROM quotation WHERE reference Like '*" & jobno & "' AND version = " & ver
Example 2:
Const BaseSQL = "SELECT [id] FROM quotation WHERE reference Like '*@jobno' AND version = @ver"
strSQL = Replace(BaseSQL, "@jobno", jobno)
strSQL = Replace(strSQL, "@ver", ver)
Example 1:
strSQL = "SELECT [id] FROM quotation WHERE reference Like '%" & jobno & "' AND version = " & ver
Example 2:
Const BaseSQL = "SELECT [id] FROM quotation WHERE reference Like '%@jobno' AND version = @ver"
strSQL = Replace(BaseSQL, "@jobno", jobno)
strSQL = Replace(strSQL, "@ver", ver)