New to Access VBA with extensive Informix SQL background. I have a recordset that includes record from 4 tables.
Based upon different situations, I want to update records in three of these tables with data from the fourth table.
I also want to add records to a comment table and output to reports. Can and how do I do this: Code follows:
Sub query_records_sql()
'Comments: Use the results of a SQL string and to update and add records as required
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSql As String
' Open pointer to current database
Set dbs = CurrentDb()
strSql = ""
'Create record set for tmp_peo records that have matches in main/prime/sub tables
strSql = " Select * FROM ((tmp_peo INNER JOIN tbl_prime ON (tmp_peo.prime = tbl_prime.prime)) " & _
" INNER JOIN tbl_sub ON (tmp_peo.sub = tbl_sub.sub)) " & _
" INNER JOIN tbl_main ON (tmp_peo.ship = tbl_main.ship_id) AND " & _
" (tbl_prime.prime_id = tbl_main.prime_id) AND (tbl_sub.sub_id = tbl_main.sub_id)"
' Create recordset based on SQL
Set rst = dbs.OpenRecordset(strSql)
Do While Not rst.EOF
If (tmp_peo.prime_nomenclature = tbl_prime.nomenclature) Then
If (tmp_peo.sub_nomenclature = tbl_sub_nomenclature) Then
If (((tmp_peo.quantity = tbl_main.quantity) Or (tmp_peo.quantity Is Null And tbl_main.quantity Is Null)) And
((tmp_peo.sked_a_mdb = tbl_main.sked_a_mbd) Or (tmp_peo.sked_a_mdb Is Null And tbl_main.sked_a_mdb Is Null)) And
((tmp_peo.swbs = tbl_main.swbs) Or (tmp_peo.swbs Is Null And tbl_main.swbs Is Null)) And
((tmp_peo.rdd_to_ptc = tbl_main.rdd_to_ptc) Or (tmp_peo.rdd_to_ptc Is Null And tbl_main.rdd_to_ptc Is Null)) And
((tmp_peo.ptc_bedd = tbl_main.ptc_bedd) Or (tmp_peo.ptc_bedd Is Null And tbl_main.ptc_bedd Is Null)) And
((tmp_peo.peo_ships_am_rdd = tbl_main.peo_ships_am_rdd) Or (tbl_peo.peo_ships_am_rdd Is Null And tbl_main.peo_ships_am_rdd Is Null)) And
((tmp_peo.sked_a_date = tbl_main.sked_a_date) Or (tbl_peo.sked_a_date Is Null And tbl_main.sked_a_date Is Null)) And
((tmp_peo.sypd = tbl_main.sypd) Or (tmp_peo.sypd Is Null And tbl_main.sypd Is Null)) And
((tmp_peo.parm_bedd_date = tbl_main.parm_bedd_date) Or (tmp_peo.par_bedd_date Is Null And tbl_main.parm_bedd_date Is Null)) And
((tmp_peo.yard_actual = tbl_main.yard_actual) Or (tmp_peo.yard_actual Is Null And tbl_main.yard.actual Is Null)) And
((tmp_peo.delivered_quantity = tbl_main.delivered_quantity) Or (tmp_peo.delivered_quantity Is Null And tbl_main.delivered_quantity Is Null)) And
((tmp_peo.shipment = tbl_main.shipment) Or (tmp_peo.shipment Is Null And tbl_main.shipment Is Null))) Then
' Output to 'No Update Required' Report
Else
' Update main with tmp_peo data
Call update_main
Call add_main_comment(tbl_main.main_id, "PRG", =DATE(), "MAIN RECORD UPDATED DURING WEEKLY PEO SKED A UPDATE PROCESS")
'Output to 'Main Record Updated' Report
End If
Else
'Update sub nomen with tmp_peo.sub_nomen
Call update_sub
Call add_main_comment(tbl_main.main_id, "PRG", =DATE(), "SUB RECORD UPDATED DURING WEEKLY PEO SKED A UPDATE PROCESS")
'Output to 'Sub Record Updated' report
End If
Else
'Update prime nomen with tmp_peo.prime_nomen
Call update_prime
Call add_main_comment(tbl_main.main_id, "PRG", =DATE(), "PRIME RECORD UPDATED DURING WEEKLY PEO SKED A UPDATE PROCESS")
'Output to "Prime Record Updated' report
End If
rst.MoveNext
Loop
'Close recordset
rst.Close
'Close Reports
'Open action required report
strSql = ""
'Create record set for tmp_peo records that have no matches in main/prime/sub tables
strSql = " Select tmp_peo.* WHERE tmp_peo.id Not In " & _
" (Select * FROM ((tmp_peo INNER JOIN tbl_prime ON (tmp_peo.prime = tbl_prime.prime)) " & _
" INNER JOIN tbl_sub ON (tmp_peo.sub = tbl_sub.sub)) " & _
" INNER JOIN tbl_main ON (tmp_peo.ship = tbl_main.ship_id) AND " & _
" (tbl_prime.prime_id = tbl_main.prime_id) AND (tbl_sub.sub_id = tbl_main.sub_id)"
dbs.Close
End Sub
Related
I have the following code below which builds/creates a description based on the Value field (where contains data) in sequential order. For example, I have a table which has the following fields...
Item
Classification
Attribute Name
Value
UOM
Status
What I'm trying to do is insert a line of code that will only build the description from the Value field (where contains data) where the Status field = Active. The Status field info is either "Active" Or "Foreign". Currently, if the Status field shows "Foreign" the code will also build the description for these records which I just learned should not be included.
Any help would be greatly appreciated! Again, below is the code...
Sub SD()
DoCmd.SetWarnings False
Dim db As DAO.Database
Dim rsMara, rs_cou As DAO.Recordset
Dim rs, rs2, x As DAO.Recordset
Dim SD, strAttribute, strValue, sdvalue As String
Dim seq, d, count1 As Integer
Set db = CurrentDb
db.Execute ("UPDATE Item_Template SET Description = '', Long_Description = '';")
Set rsMara = db.OpenRecordset("select * from [Item_Template] order by [Item]")
While Not rsMara.EOF
If rsMara.Fields("Classification") & "" <> "" Then
SD = UCase(rsMara.Fields("Classification")) & ": "
seq = 1
Set rs = db.OpenRecordset("select * from All_Item_Attributes where [Item] = '" & rsMara.Fields("Item") & "' and [Value] & '' <> '' order by [Item],[Sequence (Cls Attribute Mapping)]")
While Not rs.EOF
If (rs.Fields("UOM") Like "IN*" Or rs.Fields("UOM") Like "O*") Then
SD = SD & rs.Fields("Value") & " " & UCase(rs.Fields("UOM")) & ", "
Else
SD = SD & rs.Fields("Value") & " " & UCase(rs.Fields("UOM")) & ", "
End If
rs.MoveNext
Wend
SD = Trim(SD)
rsMara.Edit
SD = Trim(Mid(SD, 1, Len(SD) - 1))
rsMara.Fields("Description") = Trim(SD)
rsMara.Fields("Description") = Replace(rsMara.Fields("Description"), " ,", ", ")
rsMara.Fields("Description") = Replace(rsMara.Fields("Description"), " ", " ")
rsMara.Update
End If
DoEvents
rsMara.MoveNext
Wend
End Sub
You don't say which table the field Status is in.
You have two lines of code opening recordsets so it will be one of these lines of code:
Set rsMara = db.OpenRecordset("select * from [Item_Template] WHERE Status='Active' order by [Item]")
or
Set rs = db.OpenRecordset("select * from All_Item_Attributes where [Item] = '" & rsMara.Fields("Item") & "' and [Value] & '' <> '' AND Status='Active' order by [Item],[Sequence (Cls Attribute Mapping)]")
Basically adding Status='Active' into the WHERE clause. This won't work if your Status field is a lookup field in which case you'd need to use the Foreign Key value that links it to your Status type table. Status=1 for example.
I am using vba in MS Access to create Invoices in Quickbooks with QODBC.
This process requires multi line invoice items to be inserted first and saved temp till primary invoice information is inserted. I have several invoices that are in need of being inserted as bulk.
EXAMPLE:
MultiLIne (INVOICE ITEMS) = Item #, OrderID, Item Desc, etc.
**MULTILINE matches PRIMARY invoice based on OrderID
Primary (INVOICE) = OrderID, Name, Address, Billing terms, etc.
**Primary is a single line record per orderID
"QB_AppendInvoice_LoopRef" contains the unique orderid's that need to be processed. I was trying to use this as a recordset to import the multiline items based on the current recordset orderid, however, I am unable to reference the current recordset orderid.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim iCount As Integer
Set db = CurrentDb()
Set rs = db.OpenRecordset("QB_AppendInvoice_LoopRef") 'open the recordset for use (table, Query, SQL Statement)
With rs
If .RecordCount <> 0 Then 'Ensure that there are actually records to work with
'The next 2 line will determine the number of returned records
rs.MoveLast 'This is required otherwise you may not get the right count
iCount = rs.RecordCount 'Determine the number of returned records
Do While Not .BOF
DoCmd.SetWarnings False
'Append Invoice Line (determine tests ordered)
Dim SQL1 As String
SQL1 = "INSERT INTO InvoiceLine (CustomerRefListID, CustomerRefFullName, ARAccountRefListID, ARAccountRefFullName, InvoiceLineSerialNumber, InvoiceLineLotNumber, TemplateRefListID, IsPending, DueDate, TxnDate, InvoiceLineType, InvoiceLineItemRefListID, InvoiceLineItemRefFullName, InvoiceLineDesc, InvoiceLineRate, InvoiceLineAmount, FQSaveToCache, RefNumber)" & _
"SELECT Customer.ListID, Customer.FullName, '4C0000-1070045186', 'Accounts Receivable', Null, Null, '80000023-1495649075', '0', QB_ORDER_DETAILS.OrderDate, QB_ORDER_DETAILS.OrderDate, 'Item', QB_TestList_TestCodes.ListID, QB_TestList_TestCodes.FullName, QB_TestList_TestCodes.Description, QB_TestList_TestCodes.SalesOrPurchasePrice, QB_TestList_TestCodes.SalesOrPurchasePrice, '1', QB_ORDER_DETAILS.OrderID " & _
"FROM ((Customer INNER JOIN contacts ON Customer.AccountNumber = contacts.Company) INNER JOIN QB_ORDER_DETAILS ON contacts.[Full Member Info] = QB_ORDER_DETAILS.Physician) LEFT JOIN QB_TestList_TestCodes ON QB_ORDER_DETAILS.ProductID = QB_TestList_TestCodes.TestCode " & _
"WHERE QB_ORDER_DETAILS.OrderID = rs.Fields.getvalue('OrderID')"
DoCmd.RunSQL SQL1, False
'Append Invoice to Invoice Line (put the tests ordered on an invoice)
Dim SQL2 As String
SQL2 = "INSERT INTO Invoice (CustomerRefListID, CustomerRefFullName, ARAccountRefListID, ARAccountRefFullName, TemplateRefListID, [Memo], IsPending, IsToBePrinted, CustomFieldOther, ItemSalesTaxRefListID, TxnDate, DueDate, RefNumber)" & _
"SELECT Customer.ListID, Customer.FullName, '4C0000-1070045186', 'Accounts Receivable', '80000023-1495649075', [Patient_Last] & ', ' & [Patient_First] & ' - ' & [Full_Specimen_ID], '0', '0', [Patient_Last] & ', ' & [Patient_First] & ' - ' & [Full_Specimen_ID], Null, [OrderDate], [OrderDate], Orders.OrderID" & _
"FROM Customer INNER JOIN (Orders INNER JOIN contacts ON Orders.Physician = contacts.[Full Member Info]) ON Customer.AccountNumber = contacts.Company" & _
"WHERE Orders.OrderID = rs.Fields.getvalue('OrderID')"
DoCmd.RunSQL SQL2, False
.MovePrevious
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "SENT TO QB - SUCCESS!!!"
End With
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
DoCmd.SetWarnings True
End Sub
It's because you are updating a string, VBA can't use variables in string like that, here is the correct way of doiing it:
"WHERE Orders.OrderID = " & rs.Fields("OrderID").Value
And if the value is a string, you have to add quotes:
"WHERE Orders.OrderID = '" & rs.Fields("OrderID").Value & "'"
I have two tables that I wish to compare records - based on a field values. Here is what I tried :
Dim RCount As Long
Dim Rst As Recordset
Dim Rst1 As Recordset
Dim f As Field
'Current Record set
Set Rst = CurrentDb.OpenRecordset("Table1")
Set Rst1 = CurrentDb.OpenRecordset("Table2")
With Rst
For Each f In Rst1.Fields
RCount = DCount("FieldFromTable1", "Table1", "[FieldFromTable1]='" & Me.[FieldFromTable2].Value & "'")
If RCount > 0 Then
Me.Checkbox1.Value = True
End If
Next f
End With
Rst.Close
Rst1.Close
Here is my updated question, something like that I'm trying to accomplish. But still this code cycles only through currently selected record in my Table2 form.
Following on from my comment. You can use recordcounts to see if there is a record that exists and matches. You could use the following query to see if a record exists:
dim rst as recordset
dim varSQL as string
varSQL = "SELECT [fieldfromtable1] FROM Table1 WHERE [fieldfromtable1] ='" & [fieldfromtable2].value & "'"
Set Rst = CurrentDb.OpenRecordset(varSQL)
If rst.recordcount = 1 then
MsgBox "Fields have matching values !"
End If
rst.close
You could replace the =1 with >0.
Alternatively, I think you can use dcount() function which would be something like:
dim RCount as long
Rcount = dcount("fieldFromTable1","table1", "[fieldFromTable1]='" & me.[FieldFromTable2].value & "'")
if Rcount > 0 then
MsgBox "Fields have matching values !"
end if
again, you can use >0 or =1 im not sure which is most appropriate for your situation.
Edit
the following query can be performed to update the checkbox, but this isn't at form level
UPDATE table1 INNER JOIN table2 ON table1.[fieldfromtable1] = table2.[fieldfromtable2] SET table1.[checkboxField] = True
WHERE table2.[fieldfromtable2]= table1.[fieldFromtable1]
I haven't really consider an option to just UPDATE records in tables. Thsi is what It worked for me. I was just trying to set Checkbox to TRUE when record from Table1 meets criteria in Table2. A simple UPDATE solved the problem:
Dim SQL As String
niz = " UPDATE Table2" & _
" INNER JOIN Table1" & _
" ON Table1.FieldFromTable1=Table2.FieldFromTable2" & _
" SET Table2.Checkbox1=True"
DoCmd.SetWarnings False
DoCmd.RunSQL niz
DoCmd.Requery
DoCmd.SetWarnings True
I have two statements in VBA. Here is a fragment of code:
'delete records from tbl_PLAN_data
strErr = "1a"
strSQL = "DELETE tbl_PLAN_data.*"
strSQL = strSQL & " FROM tbl_PLAN_data;"
DBEngine(0)(0).Execute strSQL, dbFailOnError + dbSeeChanges
DoEvents
strErr = "2a"
'append records to tbl_PLAN_data
DBEngine(0)(0).Execute "qryAppPLAN", dbFailOnError + dbSeeChanges
DoEvents
SQL string of qryAppPLAN:
INSERT INTO tbl_PLAN_data ( ID, Qty, QtyPln, QtyAct, ProdT, TmStamp, TID, Wks, vol, v4, v4k, DataPln, Shift, DataPlnShift, GRD, Wk, Wkd, GRDLdKf, KFig )
SELECT tbl_OrderDetailsSub.OrderDetailsSubID, [Quantity]-Sum(Nz([Qtyact],0)*IIf([np]=0,1,-1)) AS Qty, tbl_OrderDetails.Quantity, Sum(Nz([Qtyact],0)*IIf([np]=0,1,-1)) AS QA, Sum(tbl_OrderDetailsSub.PT) AS SumOfPT, Now() AS TmStamp, tbl_OrderDetailsSub.TID, tbl_Tooling.WksID, tbl_OrderDetailsSub.Volume, tbl_OrderDetailsSub.Vol4, tbl_OrderDetailsSub.Vol4K, tbl_OrderDetailsSub.DataPln, tbl_OrderDetailsSub.Shift, [datapln] & "-" & [shift] AS datshift, IIf(InStr([oprdetails],"G")>0 Or InStr([oprdetails],"Hs")>0 And InStr([oprdetails],"GL")=0,1,0) AS GRD, DatePart("ww",[DataPln],0,2) AS w, DatePart("w",[DataPln],0,2) AS wd, tbl_OrderDetailsSub.TblLoadKf, Nz([Koef],1) AS Expr1
FROM ((tbl_Order INNER JOIN (tbl_OrderDetails INNER JOIN tbl_OrderDetailsSub ON tbl_OrderDetails.[OrderDetailsID] = tbl_OrderDetailsSub.[OrderDetailsID]) ON tbl_Order.[OrderID] = tbl_OrderDetails.[OrderID]) LEFT JOIN tbl_ProdAct ON tbl_OrderDetailsSub.[OrderDetailsSubID] = tbl_ProdAct.ODSubID) INNER JOIN tbl_Tooling ON tbl_OrderDetailsSub.TID = tbl_Tooling.TID
WHERE (((tbl_Order.ProdTypeID)<>"S" Or (tbl_Order.ProdTypeID) Is Null) AND ((tbl_Order.CancelledDate) Is Null) AND ((tbl_Order.RefusingReason) Is Null) AND ((Right(CStr(Nz([tbl_Order]![ProcessedDate],"12:00:00")),8))="12:00:00") AND ((tbl_Order.OrderType)<>"Pasiûlymas") AND ((tbl_Order.ShippedDate) Is Null))
GROUP BY tbl_OrderDetailsSub.OrderDetailsSubID, tbl_OrderDetails.Quantity, tbl_OrderDetailsSub.TID, tbl_Tooling.WksID, tbl_OrderDetailsSub.Volume, tbl_OrderDetailsSub.Vol4, tbl_OrderDetailsSub.Vol4K, tbl_OrderDetailsSub.DataPln, tbl_OrderDetailsSub.Shift, [datapln] & "-" & [shift], IIf(InStr([oprdetails],"G")>0 Or InStr([oprdetails],"Hs")>0 And InStr([oprdetails],"GL")=0,1,0), DatePart("ww",[DataPln],0,2), DatePart("w",[DataPln],0,2), tbl_OrderDetailsSub.TblLoadKf, Nz([Koef],1), tbl_OrderDetails.Quantity
HAVING ((([Quantity]-Sum(Nz([Qtyact],0)*IIf([np]=0,1,-1)))>0) AND ((tbl_OrderDetailsSub.DataPln)>Date()-30))
ORDER BY tbl_OrderDetailsSub.DataPln;
Sometimes at second execute statement I get error "Record is deleted". It seems logic when I append records after deletion. But how to force VBA to wait till delete statement completes?
I would suggest you create a Database Object and execute on that object rather than using the DBEngine(0)(0), as when you use this, you are not only performing an expensive operation of creating a new instance of the Database, you are also trying to query the table which you just modified (deleted), so you might have a small glitch.
Dim dbObj As DAO.Database
Set dbObj = CurrentDB()
'delete records from tbl_PLAN_data
strErr = "1a"
strSQL = "DELETE tbl_PLAN_data.* FROM tbl_PLAN_data;"
dbObj.Execute strSQL, dbFailOnError + dbSeeChanges
'Optional
'DoEvents
strErr = "2a"
'append records to tbl_PLAN_data
dbObj.Execute "qryAppPLAN", dbFailOnError + dbSeeChanges
By creating a Database Object, you are making sure the operations are made against the "active" object on which you also made a modification, so would return you the right information. DoEvents might not even be required. I have added it, if you feel it is still causing problems introduce it again and see if it makes any difference.
Good Luck !
I have two tables and I have a form linking to one of them. I want to check a value and if it is true, add the record the other table by using VBA.
Can anyone help me, please?
This is my code, but it does not work:
Dim rec1 As DAO.Recordset
Dim rec2 As DAO.Recordset
Set rec1 = CurrentDb.OpenRecordset("TotalTPAq")
Set rec2 = CurrentDb.OpenRecordset("Visi")
rec1.MoveFirst
Do Until rec1.EOF
If rec1!Date = PlanDate.Value Then ' planDate is a text box
rec2.AddNew
rec2![Planing Date History] = PlanDate.Value
rec2.Update
rec2.Close
End If
rec1.MoveNext
Loop
rec1.Close
Set rec2 = Nothing
Set rec1 = Nothing
DoCmd.Close
This should provide a start for you:
'Run query to fill table
Private Sub btnRnQry_Click()
'No value entered
If IsNull(Me.txtEntry) Or Me.txtEntry = "" Then
MsgBox ("Is null or empty")
Else
'Assign value to variable
Dim entry As String
entry = Me.txtEntry
Dim sql As String
sql = "INSERT INTO tableTwo ([First Name],Surname,[Phone Number] )" & _
"SELECT * " & _
"FROM tableOne " & _
"WHERE [First Name] = '" & entry & "';"
'Run the SQL
DoCmd.RunSQL sql
End If
End Sub