Full Version: OpenArgs
UtterAccess Discussion Forums > Microsoft® Access > Access Forms
iftikhar_k
Hi guys, I'm working on database that was developed by someone else, and I've to modify a couple of things, I'm not too familiar with openargs propery, I was hoping someone can look at this code and give me a hint what's going on. I tried to read up on UA archive but still was not clear on my problem.
Please look at the highlighted parts of the code.
What is this varItems = PutItem(varItems, "PickingSlip", mstrPickingSlip) function supposed to do.
Oknow this is a long post, I'll be very grateful for your time and help.
Please jump to the blue highlited area of the code.
Private Sub cmdBoxDetails_Click()
Dim varItems As Variant
Dim rst As Recordset
Dim dbs As Database
Dim strRecordcount As String
Dim strGTIN As String
Dim strPackaging As String
Dim strHeight As String
Dim strWidth As String
Dim strLength As String
Dim strWeight As String
Dim strItem As String
Dim strVender As String
Dim strWhere As String

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("zstblPK_Items")

mblnBoxDetails = True

With rst
strRecordcount = .RecordCount
If strRecordcount = 1 Then
strGTIN = !PI_GTIN
strItem = !PI_INVCODE
strVender = Nz(DLookup("IN_PRFVEND", "INVENTOR", "IN_CODE = '" & strItem & "'"), 0)
strWhere = "VP_ITCODE = '" & strItem & "'"
strWhere = strWhere & " AND "
strWhere = strWhere & "VP_VNCODE = '" & strVender & "'"
End If
End With

If Len(strGTIN) = 14 Then ' GTIN Scaned
strPackaging = Left(strGTIN, 1)
Select Case strPackaging
Case 0 ' Unit
strHeight = Nz(DLookup("VP_UN_H", "vnprcls", strWhere), 0)
strWidth = Nz(DLookup("VP_UN_W", "vnprcls", strWhere), 0)
strLength = Nz(DLookup("VP_UN_L", "vnprcls", strWhere), 0)
strWeight = Nz(DLookup("VP_UN_KG", "vnprcls", strWhere), 0)
strWeight = strWeight * 2.2
Case 1 ' Case
strHeight = Nz(DLookup("VP_CS_H", "vnprcls", strWhere), 0)
strWidth = Nz(DLookup("VP_CS_W", "vnprcls", strWhere), 0)
strLength = Nz(DLookup("VP_CS_L", "vnprcls", strWhere), 0)
strWeight = Nz(DLookup("VP_CS_KG", "vnprcls", strWhere), 0)
strWeight = strWeight * 2.2
Case 2 ' Master
strHeight = Nz(DLookup("VP_MS_H", "vnprcls", strWhere), 0)
strWidth = Nz(DLookup("VP_MS_W", "vnprcls", strWhere), 0)
strLength = Nz(DLookup("VP_MS_L", "vnprcls", strWhere), 0)
strWeight = Nz(DLookup("VP_MS_KG", "vnprcls", strWhere), 0)
strWeight = strWeight * 2.2
End Select
Else ' UPC Scaned
strHeight = Nz(DLookup("VP_UN_H", "vnprcls", strWhere), 0)
strWidth = Nz(DLookup("VP_UN_W", "vnprcls", strWhere), 0)
strLength = Nz(DLookup("VP_UN_L", "vnprcls", strWhere), 0)
strWeight = Nz(DLookup("VP_UN_KG", "vnprcls", strWhere), 0)
strWeight = strWeight * 2.2
End If

varItems = PutItem(varItems, "PackingListNumber", mstrPackingListNumber)
varItems = PutItem(varItems, "PickingSlip", mstrPickingSlip)
varItems = PutItem(varItems, "CompanyID", mintCompanyID)
varItems = PutItem(varItems, "BoxNumber", mstrBoxNumber)
varItems = PutItem(varItems, "UCC", mstrUCC)
varItems = PutItem(varItems, "Height", strHeight)
varItems = PutItem(varItems, "Width", strWidth)
varItems = PutItem(varItems, "Length", strLength)
varItems = PutItem(varItems, "Weight", strWeight)


Me.cmdNextbox.Enabled = True
'Me.cmdBoxDetails.Enabled = False
Me.cmdNextbox.SetFocus
DoCmd.OpenForm "Box Details", , , , acFormAdd, acDialog, varItems
End Sub
Private Sub Form_Load()

Me.txtBOLAD = GetItem(Me.OpenArgs, "PackingListNumber")
Me.txtBoxNumber = GetItem(Me.OpenArgs, "BoxNumber")
Me.txtCompanyID = GetItem(Me.OpenArgs, "CompanyID")
Me.txtPickingSlip = GetItem(Me.OpenArgs, "PickingSlip")
Me.txtUCC = GetItem(Me.OpenArgs, "UCC")
Me.txtHeight = GetItem(Me.OpenArgs, "Height")
Me.txtLength = GetItem(Me.OpenArgs, "Length")
Me.txtWidth = GetItem(Me.OpenArgs, "Width")
Me.txtWeight = GetItem(Me.OpenArgs, "Weight")

End Sub
Larry Larsen
Hi
Is it possible to see both functions "GetItem()" & "PutItem()...?
thumbup.gif
iftikhar_k
I've checked both class modules and form modules, I dunno where the programmer is hiding these two functions cryhard.gif
this data base is soo chunky, i can't even upload it shrug.gif
iftikhar_k
Hi, I just found the functions, sorry i didn't look properly before.
Jack Cowley, you've helped me many times before. Please if you can look into this one. I dunno how I can I thank you guys for this.
Function GetItem(ByVal varInfo As Variant, ByVal varItemName As Variant) As Variant
' Purpose : Retrieve a specific item value.
' This function will either return the requested GetItem(ByVal varInfo As Variant, ByVal varItemName As Variant)
' value or #NULL# if the item name wasn't found.
' Arguments : varInfo - string of items, delimited with adhcSeparator
' varItemName - name of item to retrieve from varInfo
' Returns : Variant - the value associated with varItemName.
' Calls :
' Example : If varInfo is "x=5;y=7;z=12;", calling GetItem(varInfo, "y") will return 7

Dim lngPos As Long
Dim lngEndPos As Long
Dim varResult As Variant
Dim intRet As Integer

On Error GoTo GetItem_Err

varResult = Null
lngPos = FindItemPos(varInfo, varItemName)
' If the item was found, keep a'goin'.
If lngPos > 0 Then
' Move lngPos to the start of the item value, and
' lngEndPos to the next adhcSeparator, if there is one.
lngPos = lngPos + Len(varItemName) + Len(mcAssignment)
lngEndPos = InStr(lngPos, varInfo, mcSeparator)

' Interpret a zero-length property as Null
If lngEndPos = lngPos Then
varResult = Null
Else
' If there wasn't a adhcSeparator, just use the rest
' of the info string. Otherwise, take the part between
' lngPos and lngEndPos.
If lngEndPos = 0 Then
varResult = Mid(varInfo, lngPos)
Else
varResult = Mid(varInfo, lngPos, lngEndPos - lngPos)
End If
End If
End If
GetItem = varResult

GetItem_Exit:
On Error GoTo 0
Exit Function

GetItem_Err:
Select Case Err
Case Else
ErrorHandler Err.Number, Err.Description, "GetItem"
End Select
Resume GetItem_Exit

End Function
Function PutItem(ByVal varInfo As Variant, ByVal varItemName As Variant, ByVal varItemValue As Variant) As Variant

' Append the value
'
' [varItemName]=[varItemValue];
'
' onto the varInfo value passed in. If the
' item name already exists, it is deleted first and then the new
' value is appended to the end.

' In:
' varInfo: info string with delimited pieces
' varItemName: item name to be set
' varItemValue: item value to be set
'
' Out:
' Return value: the varInfo string with the new item appended.

On Error GoTo PutItem_Err
Dim intRet As Integer
' If there's already a value in the info string for the item
' you're trying to replace, just REMOVE it.
varInfo = DeleteItem(varInfo, varItemName)
' By passing in a null or ZLS for the strItemValue, you effectively
' delete the tag.
If Len(varItemValue & "") > 0 Then
varInfo = varInfo & varItemName & mcAssignment & varItemValue & mcSeparator
End If
PutItem = varInfo
PutItem_Exit:
On Error GoTo 0
Exit Function
PutItem_Err:
Select Case Err
Case Else
ErrorHandler Err.Number, Err.Description, "PutItem"
End Select
Resume PutItem_Exit
End Function
This is a "lo-fi" version of our main content. To view the full version with more information, formatting and images, please click here.