Help with VBA sql code

D

DawnTreader

Hello All

i have a bit of code where a part number is being played around with. this
part number is a text data type and looks like this:

202617-02-04

when my code spits it out it turns into this:

202611

i can see that it is using the part number as an "equation" 17-2 = 15, 15-4
= 11, but what i cant figure out is why?

sorry for the hefty paste but here is my code:

Private Function GetPartOrderId()
Dim rst_partorders As ADODB.Recordset
Dim sql As String
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim PartOrderId As Integer
Dim ServiceRepID As Integer

PartOrderId = 0
ServiceRepID = [Forms]![frmManageAssets].[cboEmployee].Column(3)
sql = "Select PartOrderID FROM tblPartsOrder WHERE PartOrderStatusId = 1
and ServiceRepId = " & ServiceRepID & " AND PODateDeleted IS NULL ORDER BY
DateCreated ASC"

Set rst_partorders = New ADODB.Recordset
With rst_partorders
Set .ActiveConnection = cn
.Source = sql
.LockType = adLockReadOnly ' this is the fastest lock type. We arent
modifying data so we can iterate read-only
.CursorType = adOpenForwardOnly ' were going from top to bottom of
the recordset in one pass
.Open
End With

Do While Not rst_partorders.EOF
PartOrderId = rst_partorders.Fields("PartOrderId")
rst_partorders.MoveNext
Loop

If PartOrderId = 0 Then
sql = "INSERT INTO tblPartsOrder (FilledOutByID, ServiceRepId,
DateCreated, PartOrderPriorityId, PartOrderStatusId) VALUES (" &
[Forms]![frmManageAssets].[cboEmployee].Column(0) & ", " &
[Forms]![frmManageAssets].[cboEmployee].Column(3) & ", '" & Now() & "', 1, 1)"
MsgBox sql
DoCmd.RunSQL sql
Set rst_partorders = cn.Execute("Select Max(PartOrderId) As Id FROM
tblPartsOrder")
PartOrderId = rst_partorders(0)
MsgBox "Part Order " & PartOrderId & " Created", vbOKOnly, "Part
Order Created"
Call refresh_lists
End If

GetPartOrderId = PartOrderId

End Function
Private Function GetPartOrderLineItemID(lngLineProductID As Long,
txtLineIMWPartNumber As String, lngLinePartListID As Long, lngLinePartOrderID
As Long)
Dim rst_partorderlineitems As ADODB.Recordset
Dim sql As String
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim lngPartOrderLineItemId As Long
Dim PartOrderId As Integer

lngPartOrderLineItemId = 0
sql = "SELECT PartOrderLineItemId FROM subtblPartOrderLineItem WHERE
ProductId = " & lngLineProductID & " AND VisualPartId = " &
txtLineIMWPartNumber & " AND ProductPartListId = " & lngLinePartListID & "
AND PartOrderId = " & lngLinePartOrderID
MsgBox sql

Set rst_partorderlineitems = New ADODB.Recordset
With rst_partorderlineitems
Set .ActiveConnection = cn
.Source = sql
.LockType = adLockReadOnly ' this is the fastest lock type. We arent
modifying data so we can iterate read-only
.CursorType = adOpenForwardOnly ' were going from top to bottom of
the recordset in one pass
.Open
End With

Do While Not rst_partorderlineitems.EOF
lngPartOrderLineItemId =
rst_partorderlineitems.Fields("PartOrderLineItemId")
rst_partorderlineitems.MoveNext
Loop

GetPartOrderLineItemID = lngPartOrderLineItemId

End Function
Private Sub cmdCardSubtract_Click()
Dim sql As String
Dim lngPartOrderLineItemId As Long
Dim lngProductID As Long
Dim txtIMWPartNumber As String
Dim lngPartListID As Long
Dim lngPartOrderID As Long

lngProductID = Me.ProductID
txtIMWPartNumber = Me.txtIMWPartNumberID
lngPartListID = Me.PartListId
lngPartOrderID = GetPartOrderId()

lngPartOrderLineItemId = GetPartOrderLineItemID(lngProductID,
txtIMWPartNumber, lngPartListID, lngPartOrderID)

If lngPartOrderLineItemId = 0 Then
MsgBox "No Part Exists on any Part Order", vbOKOnly, "No Part Found"
Else
sql = "UPDATE subtblPartOrderLineItem SET Qty=[Qty]-1 WHERE
PartOrderLineItemID = " & lngPartOrderLineItemId
MsgBox sql
DoCmd.RunSQL sql
End If
Me.Ordering.Requery
Call refresh_lists
End Sub

Private Sub cmdCartAdd_Click()
Dim sql As String
Dim lngPartOrderLineItemId As Long
Dim lngProductID As Long
Dim txtIMWPartNumber As String
Dim lngPartListID As Long
Dim lngPartOrderID As Long

lngProductID = Me.ProductID
txtIMWPartNumber = Me.txtIMWPartNumberID
MsgBox txtIMWPartNumber
lngPartListID = Me.PartListId
lngPartOrderID = GetPartOrderId()

lngPartOrderLineItemId = GetPartOrderLineItemID(lngProductID,
txtIMWPartNumber, lngPartListID, lngPartOrderID)

If lngPartOrderLineItemId = 0 Then
sql = "INSERT INTO subtblPartOrderLineItem (ProductID, VisualPartId,
ProductPartListId, PartOrderId, QTY) Values (" & lngProductID & ", " &
txtIMWPartNumber & ", " & lngPartListID & ", " & lngPartOrderID & ", 1)"
MsgBox sql
DoCmd.RunSQL sql
Else
sql = "UPDATE subtblPartOrderLineItem SET Qty=[Qty]+1 WHERE
PartOrderLineItemID = " & lngPartOrderLineItemId
MsgBox sql
DoCmd.RunSQL sql
End If
Me.Ordering.Requery
Call refresh_lists
End Sub
 
D

DawnTreader

Hello All

nevermind... i found it.

there was a problem with the sql in 2 places.

sql = "SELECT PartOrderLineItemId FROM subtblPartOrderLineItem WHERE
ProductId = " & lngLineProductID & " AND VisualPartId = '" &
txtLineIMWPartNumber & "' AND ProductPartListId = " & lngLinePartListID & "
AND PartOrderId = " & lngLinePartOrderID

sql = "INSERT INTO subtblPartOrderLineItem (ProductID, VisualPartId,
ProductPartListId, PartOrderId, QTY) Values (" & lngProductID & ", '" &
txtIMWPartNumber & "', " & lngPartListID & ", " & lngPartOrderID & ", 1)"

both needed ' around the txtIMWPartNumber in the sql. now it works great. :)


DawnTreader said:
Hello All

i have a bit of code where a part number is being played around with. this
part number is a text data type and looks like this:

202617-02-04

when my code spits it out it turns into this:

202611

i can see that it is using the part number as an "equation" 17-2 = 15, 15-4
= 11, but what i cant figure out is why?

sorry for the hefty paste but here is my code:

Private Function GetPartOrderId()
Dim rst_partorders As ADODB.Recordset
Dim sql As String
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim PartOrderId As Integer
Dim ServiceRepID As Integer

PartOrderId = 0
ServiceRepID = [Forms]![frmManageAssets].[cboEmployee].Column(3)
sql = "Select PartOrderID FROM tblPartsOrder WHERE PartOrderStatusId = 1
and ServiceRepId = " & ServiceRepID & " AND PODateDeleted IS NULL ORDER BY
DateCreated ASC"

Set rst_partorders = New ADODB.Recordset
With rst_partorders
Set .ActiveConnection = cn
.Source = sql
.LockType = adLockReadOnly ' this is the fastest lock type. We arent
modifying data so we can iterate read-only
.CursorType = adOpenForwardOnly ' were going from top to bottom of
the recordset in one pass
.Open
End With

Do While Not rst_partorders.EOF
PartOrderId = rst_partorders.Fields("PartOrderId")
rst_partorders.MoveNext
Loop

If PartOrderId = 0 Then
sql = "INSERT INTO tblPartsOrder (FilledOutByID, ServiceRepId,
DateCreated, PartOrderPriorityId, PartOrderStatusId) VALUES (" &
[Forms]![frmManageAssets].[cboEmployee].Column(0) & ", " &
[Forms]![frmManageAssets].[cboEmployee].Column(3) & ", '" & Now() & "', 1, 1)"
MsgBox sql
DoCmd.RunSQL sql
Set rst_partorders = cn.Execute("Select Max(PartOrderId) As Id FROM
tblPartsOrder")
PartOrderId = rst_partorders(0)
MsgBox "Part Order " & PartOrderId & " Created", vbOKOnly, "Part
Order Created"
Call refresh_lists
End If

GetPartOrderId = PartOrderId

End Function
Private Function GetPartOrderLineItemID(lngLineProductID As Long,
txtLineIMWPartNumber As String, lngLinePartListID As Long, lngLinePartOrderID
As Long)
Dim rst_partorderlineitems As ADODB.Recordset
Dim sql As String
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim lngPartOrderLineItemId As Long
Dim PartOrderId As Integer

lngPartOrderLineItemId = 0
sql = "SELECT PartOrderLineItemId FROM subtblPartOrderLineItem WHERE
ProductId = " & lngLineProductID & " AND VisualPartId = " &
txtLineIMWPartNumber & " AND ProductPartListId = " & lngLinePartListID & "
AND PartOrderId = " & lngLinePartOrderID
MsgBox sql

Set rst_partorderlineitems = New ADODB.Recordset
With rst_partorderlineitems
Set .ActiveConnection = cn
.Source = sql
.LockType = adLockReadOnly ' this is the fastest lock type. We arent
modifying data so we can iterate read-only
.CursorType = adOpenForwardOnly ' were going from top to bottom of
the recordset in one pass
.Open
End With

Do While Not rst_partorderlineitems.EOF
lngPartOrderLineItemId =
rst_partorderlineitems.Fields("PartOrderLineItemId")
rst_partorderlineitems.MoveNext
Loop

GetPartOrderLineItemID = lngPartOrderLineItemId

End Function
Private Sub cmdCardSubtract_Click()
Dim sql As String
Dim lngPartOrderLineItemId As Long
Dim lngProductID As Long
Dim txtIMWPartNumber As String
Dim lngPartListID As Long
Dim lngPartOrderID As Long

lngProductID = Me.ProductID
txtIMWPartNumber = Me.txtIMWPartNumberID
lngPartListID = Me.PartListId
lngPartOrderID = GetPartOrderId()

lngPartOrderLineItemId = GetPartOrderLineItemID(lngProductID,
txtIMWPartNumber, lngPartListID, lngPartOrderID)

If lngPartOrderLineItemId = 0 Then
MsgBox "No Part Exists on any Part Order", vbOKOnly, "No Part Found"
Else
sql = "UPDATE subtblPartOrderLineItem SET Qty=[Qty]-1 WHERE
PartOrderLineItemID = " & lngPartOrderLineItemId
MsgBox sql
DoCmd.RunSQL sql
End If
Me.Ordering.Requery
Call refresh_lists
End Sub

Private Sub cmdCartAdd_Click()
Dim sql As String
Dim lngPartOrderLineItemId As Long
Dim lngProductID As Long
Dim txtIMWPartNumber As String
Dim lngPartListID As Long
Dim lngPartOrderID As Long

lngProductID = Me.ProductID
txtIMWPartNumber = Me.txtIMWPartNumberID
MsgBox txtIMWPartNumber
lngPartListID = Me.PartListId
lngPartOrderID = GetPartOrderId()

lngPartOrderLineItemId = GetPartOrderLineItemID(lngProductID,
txtIMWPartNumber, lngPartListID, lngPartOrderID)

If lngPartOrderLineItemId = 0 Then
sql = "INSERT INTO subtblPartOrderLineItem (ProductID, VisualPartId,
ProductPartListId, PartOrderId, QTY) Values (" & lngProductID & ", " &
txtIMWPartNumber & ", " & lngPartListID & ", " & lngPartOrderID & ", 1)"
MsgBox sql
DoCmd.RunSQL sql
Else
sql = "UPDATE subtblPartOrderLineItem SET Qty=[Qty]+1 WHERE
PartOrderLineItemID = " & lngPartOrderLineItemId
MsgBox sql
DoCmd.RunSQL sql
End If
Me.Ordering.Requery
Call refresh_lists
End Sub
Click to expand...
 
V

vbasean

Dawn,

I think there are few people who would want to read through and interpret
the code. What are you trying to accomplish? This would help the community
focus on your issue.

--
~Your Friend Chris
http://myvbastuff.blogspot.com/
thinking out loud


DawnTreader said:
Hello All

i have a bit of code where a part number is being played around with. this
part number is a text data type and looks like this:

202617-02-04

when my code spits it out it turns into this:

202611

i can see that it is using the part number as an "equation" 17-2 = 15, 15-4
= 11, but what i cant figure out is why?

sorry for the hefty paste but here is my code:

Private Function GetPartOrderId()
Dim rst_partorders As ADODB.Recordset
Dim sql As String
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim PartOrderId As Integer
Dim ServiceRepID As Integer

PartOrderId = 0
ServiceRepID = [Forms]![frmManageAssets].[cboEmployee].Column(3)
sql = "Select PartOrderID FROM tblPartsOrder WHERE PartOrderStatusId = 1
and ServiceRepId = " & ServiceRepID & " AND PODateDeleted IS NULL ORDER BY
DateCreated ASC"

Set rst_partorders = New ADODB.Recordset
With rst_partorders
Set .ActiveConnection = cn
.Source = sql
.LockType = adLockReadOnly ' this is the fastest lock type. We arent
modifying data so we can iterate read-only
.CursorType = adOpenForwardOnly ' were going from top to bottom of
the recordset in one pass
.Open
End With

Do While Not rst_partorders.EOF
PartOrderId = rst_partorders.Fields("PartOrderId")
rst_partorders.MoveNext
Loop

If PartOrderId = 0 Then
sql = "INSERT INTO tblPartsOrder (FilledOutByID, ServiceRepId,
DateCreated, PartOrderPriorityId, PartOrderStatusId) VALUES (" &
[Forms]![frmManageAssets].[cboEmployee].Column(0) & ", " &
[Forms]![frmManageAssets].[cboEmployee].Column(3) & ", '" & Now() & "', 1, 1)"
MsgBox sql
DoCmd.RunSQL sql
Set rst_partorders = cn.Execute("Select Max(PartOrderId) As Id FROM
tblPartsOrder")
PartOrderId = rst_partorders(0)
MsgBox "Part Order " & PartOrderId & " Created", vbOKOnly, "Part
Order Created"
Call refresh_lists
End If

GetPartOrderId = PartOrderId

End Function
Private Function GetPartOrderLineItemID(lngLineProductID As Long,
txtLineIMWPartNumber As String, lngLinePartListID As Long, lngLinePartOrderID
As Long)
Dim rst_partorderlineitems As ADODB.Recordset
Dim sql As String
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim lngPartOrderLineItemId As Long
Dim PartOrderId As Integer

lngPartOrderLineItemId = 0
sql = "SELECT PartOrderLineItemId FROM subtblPartOrderLineItem WHERE
ProductId = " & lngLineProductID & " AND VisualPartId = " &
txtLineIMWPartNumber & " AND ProductPartListId = " & lngLinePartListID & "
AND PartOrderId = " & lngLinePartOrderID
MsgBox sql

Set rst_partorderlineitems = New ADODB.Recordset
With rst_partorderlineitems
Set .ActiveConnection = cn
.Source = sql
.LockType = adLockReadOnly ' this is the fastest lock type. We arent
modifying data so we can iterate read-only
.CursorType = adOpenForwardOnly ' were going from top to bottom of
the recordset in one pass
.Open
End With

Do While Not rst_partorderlineitems.EOF
lngPartOrderLineItemId =
rst_partorderlineitems.Fields("PartOrderLineItemId")
rst_partorderlineitems.MoveNext
Loop

GetPartOrderLineItemID = lngPartOrderLineItemId

End Function
Private Sub cmdCardSubtract_Click()
Dim sql As String
Dim lngPartOrderLineItemId As Long
Dim lngProductID As Long
Dim txtIMWPartNumber As String
Dim lngPartListID As Long
Dim lngPartOrderID As Long

lngProductID = Me.ProductID
txtIMWPartNumber = Me.txtIMWPartNumberID
lngPartListID = Me.PartListId
lngPartOrderID = GetPartOrderId()

lngPartOrderLineItemId = GetPartOrderLineItemID(lngProductID,
txtIMWPartNumber, lngPartListID, lngPartOrderID)

If lngPartOrderLineItemId = 0 Then
MsgBox "No Part Exists on any Part Order", vbOKOnly, "No Part Found"
Else
sql = "UPDATE subtblPartOrderLineItem SET Qty=[Qty]-1 WHERE
PartOrderLineItemID = " & lngPartOrderLineItemId
MsgBox sql
DoCmd.RunSQL sql
End If
Me.Ordering.Requery
Call refresh_lists
End Sub

Private Sub cmdCartAdd_Click()
Dim sql As String
Dim lngPartOrderLineItemId As Long
Dim lngProductID As Long
Dim txtIMWPartNumber As String
Dim lngPartListID As Long
Dim lngPartOrderID As Long

lngProductID = Me.ProductID
txtIMWPartNumber = Me.txtIMWPartNumberID
MsgBox txtIMWPartNumber
lngPartListID = Me.PartListId
lngPartOrderID = GetPartOrderId()

lngPartOrderLineItemId = GetPartOrderLineItemID(lngProductID,
txtIMWPartNumber, lngPartListID, lngPartOrderID)

If lngPartOrderLineItemId = 0 Then
sql = "INSERT INTO subtblPartOrderLineItem (ProductID, VisualPartId,
ProductPartListId, PartOrderId, QTY) Values (" & lngProductID & ", " &
txtIMWPartNumber & ", " & lngPartListID & ", " & lngPartOrderID & ", 1)"
MsgBox sql
DoCmd.RunSQL sql
Else
sql = "UPDATE subtblPartOrderLineItem SET Qty=[Qty]+1 WHERE
PartOrderLineItemID = " & lngPartOrderLineItemId
MsgBox sql
DoCmd.RunSQL sql
End If
Me.Ordering.Requery
Call refresh_lists
End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Need help in printing vba code 0
VBA code issue...Would love expert help. 5
Error "no value given for one or more required parameters" HELP 3
SQL statement not returning any records 1
Delete with SQL code 4
Help with SQL 2
Problems with SQL in vba code 2
VBA ADO SQL Query Problem 8

Top