My Assistant
![]() ![]() |
|
|
Nov 22 2004, 10:23 AM
Post
#1
|
|
|
UtterAccess Addict Posts: 296 From: Toronto Canada |
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. I know 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 |
|
|
|
Nov 22 2004, 10:54 AM
Post
#2
|
|
|
UA Editor + Utterly Certified Posts: 22,722 From: Melton Mowbray,Leicestershire (U.K) |
Hi
Is it possible to see both functions "GetItem()" & "PutItem()...? (IMG:http://www.utteraccess.com/forum/style_emoticons/default/thumbup.gif) |
|
|
|
Nov 22 2004, 11:52 AM
Post
#3
|
|
|
UtterAccess Addict Posts: 296 From: Toronto Canada |
I've checked both class modules and form modules, I dunno where the programmer is hiding these two functions (IMG:http://www.utteraccess.com/forum/style_emoticons/default/cryhard.gif)
this data base is soo chunky, i can't even upload it (IMG:http://www.utteraccess.com/forum/style_emoticons/default/shrug.gif) |
|
|
|
Nov 22 2004, 12:40 PM
Post
#4
|
|
|
UtterAccess Addict Posts: 296 From: Toronto Canada |
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 |
|
|
|
![]() ![]() |
|
Go to Top · Lo-Fi Version | Time is now: 22nd May 2013 - 05:56 PM |