I'm implementing a stock transfer system into the dbase for a new branch interstate. I need to assign new jobnumbers to the items, and in order to avoid duplicates I've decided to use a prefix (In this case ADL for adeliade, and TX for transfer).
I've written it all up, and everything functions, but as soon as I insert the letters before the job number, it dies midstride! I've spent 4 hours trying to make this work now, I really need some help!
Regarding the code below, yes, it's messy, there are no-longer accurate comments in it, etc etc. I tend to tidy up/optimise afterwards, forgive me.
I've written it all up, and everything functions, but as soon as I insert the letters before the job number, it dies midstride! I've spent 4 hours trying to make this work now, I really need some help!
Regarding the code below, yes, it's messy, there are no-longer accurate comments in it, etc etc. I tend to tidy up/optimise afterwards, forgive me.
Code:
Private Sub TransferBTN_Click()
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
'our temp record set for getting the transfer status
rst.ActiveConnection = CurrentProject.Connection
rst.CursorType = adOpenStatic
rst.LockType = adLockOptimistic
Dim JobNoStr As String 'Holds the new job number
Dim dbs As Database
Set dbs = CurrentProject.Application.CurrentDb
If IsNull(Me.ListTransfer.Column(1)) Then
MsgBox "Cannot transfer nothing. Add some items to the list first."
GoTo Exit_TransferBTN_Click
End If
'get all data from ADL stock on hand that has been put in the list
rst.Open "(SELECT * from tblstockonhand where PackNoId = " & Me.ListTransfer.Column(1) & ";)"
rst![Transfer] = "Y" 'Give it transfer status
rst.Update
rst.Close
'need to add checks to avoid job number dupes
If txtJobNo.Value = " " Or txtJobNo.Value = "" Then
JobNoStr = Trim(InputBox("Enter the Job Number you wish to assign to this item.", "Job Number Request"))
Else
JobNoStr = "ADLTX" & Trim(txtJobNo.Value)
'JobNoStr = Trim(txtJobNo.Value)
End If
'Add the item to Transfer Stock
dbs.Execute ("INSERT INTO tblstockontransfer SELECT ParentPackId,ByWhom,LastModified,Transfer,CreditRecord,InvNo,UnitSellPrice,FISDelivery,HowDelivered,FreightInvoiced,Freight,FreightCharged,FreightCost,SalesPerson,PurchaseOrdNo,DateSold,Location,AttIntComments,IntCategory,IntComments,DateIntendedFor,IntendedFor,Company,Packaging,ProcessingCost,ProcessingFreight,ProcessingTime,DateProcessingCompleted,ProcessingOrdNo,DateProcessingOrdered,Machine,ProcessedBy,Quantity,Cost,ArticleNo,AttComments1,AttComments2,ExtComments,ID,Comments,OD,Length,Finish,Coating,Grade,ProductCode,Category,SubType,Type,ManufacturingStandard,Status,Origin,UltimateParent,DateOrdered,DatePromised,PromisedBy,DateReceived,OpportunityBuy,Thickness,Width FROM tblstockonhand WHERE PackNoId = " & Me.ListTransfer.Column(1) & ";")
MsgBox JobNoStr
dbs.Execute ("UPDATE tblstockontransfer SET [JobNo] = " & JobNoStr & " WHERE [Transfer] = 'Y';") ' assign new job number
MsgBox "part2"
rst.Open "(SELECT * from tblstockontransfer where Transfer = 'Y';)" 'grab all items being transfered
MsgBox "part3"
rst![Transfer] = "N" 'and close their transfer status
rst.Update
rst.Close
MsgBox "part4"
dbs.Execute ("UPDATE tblstockonhand SET [InvNo] = " & JobNoStr & " WHERE [PackNoId] = " & Me.ListTransfer.Column(1) & ";")
rst.Open "(SELECT PackNoId,Weight from tbl_tmp_PacksSold where PackNoId = " & Me.ListTransfer.Column(1) & ";)"
' delete record
rst.Delete
rst.Close
MsgBox "part5"
rst.Open "tblTransferJobs", CurrentProject.Connection, adOpenStatic, adLockOptimistic
rst.AddNew
MsgBox "part6"
rst![JobNo] = JobNoStr
MsgBox "part7"
rst.Update
rst.Close
MsgBox "part8"
Set rst = Nothing
Me.Refresh
DoCmd.OpenReport "rptPickSlip", acViewDesign
Reports("rptPickSlip").RecordSource = "(SELECT * FROM tblstockontransfer WHERE JobNo = " & JobNoStr & ";)"
DoCmd.Save
DoCmd.OpenReport "rptPickSlip", acPreview
MsgBox "Items are in the Transfer area."
Form_Load
Exit_TransferBTN_Click:
Exit Sub
End Sub