I have the following table (tmpManifest - ID is the PK) - the data is populated from a barcode scanner so I cannot control how it is created:
However, I need to populate the Box column to look like the below - it needs to know when to change to correct Box:
What is the best way to achieve this via an Update query?
Try this solution - will loop through each record and update one by one.
Dim SQL As String, sUPC As String, sID As String
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT [ID], [UPC], [Description] FROM [tmpManifest] ORDER BY [ID] ASC")
If Not (rs.EOF And rs.BOF) Then
Do While Not rs.EOF
sID = CStr(rs![ID])
If IsNull(rs![Description]) Then
SQL = "UPDATE [tmpManifest] SET [BOX] = '" & sUPC & "' WHERE [ID] = " & sID
CurrentDb.Execute SQL
Else
sUPC = CStr(rs![UPC])
SQL = "UPDATE [tmpManifest] SET [BOX] = '" & sUPC & "' WHERE [ID] = " & sID
CurrentDb.Execute SQL
End If
rs.MoveNext
Loop
End If
Related
I have a MS Access app with a MySQL database. I have tried numerous ways from Stack Overflow but can't get the primary key of a newly added row.
I have tried everything I can find with no luck.
Set pxRST = db.OpenRecordset("SELECT * from tblPatients WHERE dispenseID = " & oPxID & " AND ChemistID = " & chemID, dbOpenDynaset, dbSeeChanges)
if pxrst.eof then
pxRST.AddNew
pxRST("dispenseid") = oPxID
pxRST("chemistID") = chemID
pxRST("firstname") = firstName
pxRST("lastname") = lastName
pxRST("address") = Address
pxRST("postcode") = postcode
pxRST("phonenumber") = phonenumber
pxRST.Update
pxRST.Bookmark = pxRST.LastModified
gPxID = pxRST!PatientID
Debug.Print gPxID
end if
This gave a "record is deleted" error
I have also tried using one that had
gPxID = currentdb.openrecordset("SELECT ##identity").value(0)
This just game me 0 as a figure
I did go into MYSQL workbench and try
INSERT INTO tblpatients
SELECT ##IDENTITY
and I did get a new record's ID.
So I've tried hard and got so far but I just can't figure it out from here and how to get this working in VBA.
I'm currently working on using QueryDefs, but I'm very new to this and haven't really got there I don't think.
Dim qdf2 As DAO.QueryDef
strSQL = "INSERT INTO tblPatients (dispenseid,chemistID,firstname,lastname,address,postcode,phonenumber) " & _
"VALUES (" & oPxID & "," & chemID & ",'" & firstName & "','" & lastName & "','" & Address & "','" & postcode & "','" & phonenumber & "' )"
Set qdf2 = db.QueryDefs("quGetPxDetails")
With qdf2
.SQL = strSQL
.Connect = oCon
qdf2.Execute
End With
It rather depend upon whether your tblPatients has an auto increment primary key or not.
If it does then you should not be assigning it a value manually, ie your
INSERT INTO tblPatients (dispenseid,chemistID,firstname,lastname,address,postcode,phonenumber) " & _
"VALUES (" & oPxID & "," & chemID & ",'" & firstName & "','" & lastName & "','" & Address & "','" & postcode & "','" & phonenumber & "' )"
is not inserting anything into the PK.
Lets assume that you do have a column in tblPatients called
PatientID of type int(11) NOT NULL AUTO_INCREMENT,
Now, after you insert a new record you can get back the id of that inserted record using the function
LAST_INSERT_ID()
so
Select LAST_INSERT_ID() as my_last_pk;
would return the PK of the record you just inserted in a column called my_last_pk.
Note that this is session specific so if you and someone else both insert a new record at more or less the same time you would each get back your own inserted PK.
So my answer comes from both ComputerVersteher and User2834566 info.
I had to run two queries, both as passthrough and running on the same db instance to make sure it returned the right value:
Dim strSQL As String
Dim qdf As DAO.QueryDef
Dim db As DAO.Database
Dim rst As DAO.Recordset
strSQL = "INSERT INTO medstome_masterdb.tblChemists (chemName) VALUES ('newchem')"
strGETID = "SELECT ##IDENTITY"
Set db = CurrentDb
With db
Set qdf = db.CreateQueryDef("")
With qdf
.ReturnsRecords = False
.Connect = oCon
.SQL = strSQL
.Execute
End With
With qdf
.ReturnsRecords = True
.Connect = oCon
.SQL = strGETID
Set rst = .OpenRecordset(dbOpenSnapshot)
gPxID = rst(0)
Debug.Print gPxID
End With
End With
This works perfectly!
Thanks to the guys responding and helping
I have table with columns like key,English Phrase and that phrase with other 40 languages.See in following image :
I want to break the records of these table by it's language column like following image:
I did this using the following code:
Sub InsertIntoMasterPhrases()
Dim objRecordsetMaster As ADODB.Recordset
Set objRecordsetMaster = New ADODB.Recordset
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordsetMaster.ActiveConnection = CurrentProject.Connection
objRecordset.ActiveConnection = CurrentProject.Connection
objRecordsetMaster.Open ("SELECT [Master Table].* FROM [Master Table];")
While objRecordsetMaster.EOF = False
objRecordset.Open ("Select [SAP_LANGUAGE to LANG].[LANGUAGE NAME], [SAP_LANGUAGE to LANG].[LANGUAGE] " & _
"From [SAP_LANGUAGE to LANG]")
While objRecordset.EOF = False
key = objRecordsetMaster.Fields("Key").Value
englishPhrase = objRecordsetMaster.Fields("English Phrase").Value
language = objRecordset.Fields("LANGUAGE").Value
translation = objRecordsetMaster.Fields(languageName).Value
If (GetRecordsExist(CStr(key), CStr(englishPhrase), CStr(language)) = "") Then
Query = "INSERT INTO [Language Sample](Key,English,Translation,Language)VALUES ('" & key & "','" & englishPhrase & "','" & translation & "','" & language & "');"
CurrentDb.Execute Query
End If
objRecordset.MoveNext
Wend
objRecordset.Close
objRecordsetMaster.MoveNext
Wend
objRecordsetMaster.Close
End Sub
//Checking records already exist in table
Function GetRecordsExist(key As String, english As String, language As String) As String
Dim db As Database
Dim Lrs As DAO.Recordset
Dim LGST As String
Set db = CurrentDb()
Set Lrs = db.OpenRecordset("SELECT KEY FROM [Language Sample] where KEY='" & key & "' and English='" & english & "' and Language = '" & language & "'")
If Lrs.EOF = False Then
LGST = "Found"
Else
LGST = ""
End If
Lrs.Close
Set Lrs = Nothing
GetRecordsExist = LGST
End Function
In the Master table i have 15000 records and when its breaking 15000 records it becomes 15000 * 40 = 600000. above code inserting almost 10000 records per minutes and after few hour it' hangs up . But also it don't produce any error then i have to restart the access. Kindly help how can i do it in better way.
Alternative 1:
Use a large UNION query to append many records with one SQL statement, as described here:
How to simulate UNPIVOT in Access 2010?
You will probably want to split it into several chunks (e.g. 5 or 10 languages at a time), or Access might choke on the query.
Alternative 2:
Instead of running INSERT statements for each record, use a DAO recordset with .AddNew. This is faster by magnitudes, see this answer:
https://stackoverflow.com/a/33025620/3820271
I have a table in MS Access that has +17K of records. I am trying to break down that table into smaller tables of 500 records each. Using the following code, I am able to create the temp table, but I cannot reset the number of ID column. The ID column on the original table is an autonumber. I am trying to reset the ID field on the temp table so I can do a record search starting at 1 and going to 500.
The alter SQL that I have does not update/reset the temp table's ID column to 1. Any ideas?
Function SplitTables_Actual()
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
Dim rowcount As Long
Dim tblcount As Integer
Dim i As Integer
SQL = "SELECT * INTO tmp_Flush_Actual FROM BIG_Table"
DoCmd.RunSQL SQL
SQL = "ALTER TABLE tmp_Flush_Actual ALTER COLUMN ID COUNTER(1,1)"
DoCmd.RunSQL SQL
SQL = "SELECT count(*) as rowcount from BIG_Table"
rs.Open SQL, cn
rowcount = rs!rowcount
rs.Close
tblcount = rowcount / 500 + 1
For i = 1 To tblcount
SQL = "SELECT * into tmp_flush_Actual" & i & " FROM tmp_Flush_Actual" & _
" WHERE ID <= 500*" & i
DoCmd.RunSQL SQL
SQL = "DELETE * FROM tmp_Flush_Actual" & _
" WHERE ID<= 500*" & i
DoCmd.RunSQL SQL
Next i
End Function
Bottom line, on the initial query, don't select the ID (Autonumber) column. Select the columns you want into the initial temp table, then alter the table to add a new counter column. I used COUNTER(1,1) so that each time the temp table is created, the first record is 1.
I added a little nugget that saves the broken files to a folder. I commented out the error handling, but uncomment it to make sure your save directory is working correctly.
Function SplitTables_RTPA_Actual()
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
Dim rowcount As Long
Dim tblcount As Integer
Dim i As Integer
'Just don't select the ID column
SQL = "SELECT Company, Incurred_By, Transaction_Type, Format(Transaction_Date, 'mm/dd/yyyy'), Investment_ID, " & _
"Task_ID, Charge_Code, Resource_ID, Role, Notes, Quantity INTO tmp_Flush_Tran_Actual FROM Actual_Transaction_Data"
DoCmd.RunSQL SQL
SQL = "ALTER TABLE tmp_Flush_Tran_Actual ADD COLUMN ID COUNTER(1,1)"
DoCmd.RunSQL SQL
SQL = "SELECT count(*) as rowcount from Actual_Transaction_Data"
rs.Open SQL, cn
rowcount = rs!rowcount
rs.Close
tblcount = rowcount / 100 + 1
For i = 1 To tblcount
'Create Temp Flush File
SQL = "SELECT * into tmp_Flush_Tran_Actual" & i & " FROM tmp_Flush_Tran_Actual" & _
" WHERE ID <=100*" & i
DoCmd.RunSQL SQL
SQL = "ALTER TABLE tmp_Flush_Tran_Actual" & i _
& " DROP COLUMN ID;"
DoCmd.RunSQL SQL
'Delete 500 from Temp Flush File
SQL = "DELETE * FROM tmp_Flush_Tran_Actual" & _
" WHERE ID <=100*" & i
DoCmd.RunSQL SQL
'On Error GoTo ErrorHandler
Dim strTable As String
Dim strWorksheetPath As String
'Location where you want to save the broken out files
strWorksheetPath = "C:\YOUR TEMP FOLDER\TEST\"
strWorksheetPath = strWorksheetPath & "Actual_Transactions" & i & ".xls"
strTable = "tmp_Flush_Tran_Actual" & i
DoCmd.TransferSpreadsheet transfertype:=acExport, spreadsheettype:=acSpreadsheetTypeExcel9, TableName:=strTable, FileName:=strWorksheetPath, hasfieldnames:=True
'ErrorHandlerExit:
' Exit Function
' 'Next i
'
'ErrorHandler:
' MsgBox "Error No: " & Err.Number _
' & "; Description: " & Err.Description
' Resume ErrorHandlerExit
Next i
End Function
I'm new to Access so bear with me here.
I have a form that allows me to add new data to a table
ID | Name | City | Zip Code
1 | John | Newark | 12340
2 | Alex | Boston | 98760
So on and so forth...
Before proceeding to add a new record with the above data fields, I need to create a check that will look at the table to determine if the combinations of Name, City and Zip Code already exist. If they do, I want it to Exit Sub; Else continue with the rest of the macro.
I've been looking to build this using some form of the OpenRecordset command, but I'm not sure where to begin. Can someone point me in the right direction? Thanks!
I just wrote this code to recreate your situation and it worked fine. You just need to rename your columns and your table in the query.
Dim strSQL As String
Dim qdf As QueryDef
'if these columns are not text change to approriate type
strSQL = "PARAMETERS [NameToCheck] Text(255),[CityToCheck] Text(255),[Zip] Text(255); "
'change table name and column names here
strSQL = strSQL & "SELECT Count(*) FROM address " _
& "WHERE FName = [NameToCheck] AND City = [CityToCheck] AND ZipCode = [Zip];"
Set qdf = CurrentDb.CreateQueryDef("", strSQL)
qdf("NameToCheck") = txtName.Value 'change to that textfield on form
qdf("CityToCheck") = txtCity.Value 'change to that textfield on form
qdf("Zip") = txtZipCode.Value 'change to that textfield on form
If qdf.OpenRecordset(dbOpenSnapshot)(0) > 0 Then
MsgBox "This record is already in the database"
Else
'Insert statement goes here.
End If
If you want to use recordsets as you requested then you would need to use a SQL statement to select all or use it to find something by name.
Dim myR as Recordset
Dim strSQL as String
'run a SQL statement to select a record with the same info
strSQL = "SELECT [Name], [City], [Zip Code] FROM table_name_here " & _
"WHERE [Name] = '" & form_control_name & "' " & _
"AND [City] = '" & form_control_city & "' " & _
"AND [Zip Code] = '" & form_control_zip & "'"
'set your recordset to the SQL statment
Set myR = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
'if your count is greater than 0, then you'll have a duplicate
If myR.RecordCount > 0 then
MsgBox "This already exists"
Else
MsgBox "All clear"
End if
Set myR = Nothing
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