My database needs the ability to mass import data from multiple sources and merge into existing records if they exist and add new if they do not.
Problem lies with the source data, a lot of the field types do not match the values the same fields have within the database. (Example all 'Location' in the excel documents will be text, within the database 'Location' is numerical)
To counteract this I have basically made 2 new tables. 'Importer' & 'Cleaned'
Importer is loaded into a continuous form and the field controls within the form then do a little magic to convert the text values to numerical. The issue I'm having is getting my code to run and input the required data into Cleaned.
I've tried the following various iterations on the new record line
myR2![EventID] = Me.EventIDUpdater.Value
myR2![EventID] = [Forms]![adf_AttendeeImport]![EventIDUpdater]
myR2![EventID] = [Forms]![adf_AttendeeImport]![EventIDUpdater].[Value]
None of which have the desired effect.
I went through the code line-by-line using breakpoints, nothing came from it.
Below is the full code (This works for another more advanced merge existing/add new import)
Private Sub MergeAttendees_Click()
Dim myR As Recordset
Dim myR2 As Recordset
Set myR = CurrentDb.OpenRecordset("tbl_STG_AttendeeImport", dbOpenDynaset)
Set myR2 = CurrentDb.OpenRecordset("tbl_STG_AttendeeValueUpdater", dbOpenDynaset)
MsgBox prompt:="You are about to convert multiple values, this could take some time. Please allow the process to complete before closing the window/database", buttons:=vbInformation, Title:="Conversion Warning"
Do Until myR.EOF = True
myR2.AddNew
myR2![Email] = myR![Email]
myR2![TicketAmount] = myR![TicketAmount]
myR2![Price] = myR![Price]
myR2![Paid] = myR![Paid]
myR2![EventID] = Me.EventIDUpdater.Value
myR2![AttendeeTypeID] = Me.AttendeeTypeIDUpdater.Value
myR2![PackageID] = Me.PackageIDUpdater.Value
myR2![TicketTypeID] = Me.TicketTypeIDUpdater.Value
myR2![DiscountID] = Me.DiscountIDUpdater.Value
myR2![MethodID] = Me.MethodIDUpdater.Value
myR2![ConfirmationID] = Me.ConfirmationIDUpdater.Value
myR2.Update
myR.MoveNext
Loop
DoCmd.SetWarnings False
DoCmd.OpenQuery ("upd_AttendeeImport")
DoCmd.OpenQuery ("del_AttendeeImport")
Me.Requery
DoCmd.SetWarnings True
MsgBox prompt:="Update Complete - Staging Table Cleared", buttons:=vbInformation, Title:="Update Complete"
End Sub
I do get the confirmation "Update Complete - Staging Table Cleared" per the msgbox line just before the sub ends. And data is saved into the table however I've noticed the data saved is incorrect (Most likely due to the way I'm getting said data as all records are saving the data of the first fields in the repeated form)
What I need it to do is read down the form correctly and save the data.
I opted against VBA and form control data to complete what is needed and instead set up several update queries joined on the relevant table to update the values back into the staging table and then used VBA to run the queries in succession.
After the values were updated I used a final upend query to add/update the correct values into the right table and added this to VBA code also.
Private Sub ConvertValues_Click()
DoCmd.SetWarnings False
DoCmd.OpenQuery ("upd_AVI_ConfirmID")
DoCmd.OpenQuery ("upd_AVI_DiscountID")
DoCmd.OpenQuery ("upd_AVI_EventID")
DoCmd.OpenQuery ("upd_AVI_GuestID")
DoCmd.OpenQuery ("upd_AVI_MethodID")
DoCmd.OpenQuery ("upd_AVI_PackageID")
DoCmd.OpenQuery ("upd_AVI_TicketID")
Me.Requery
DoCmd.OpenQuery ("upd_AttendeeImport")
DoCmd.OpenQuery ("del_AttendeeImport")
Me.Requery
DoCmd.SetWarnings True
End Sub
I have a table that is populated with data from a delimited text file. The data comes from another system and I cannot modify how it is generated into the text file I am importing. Once the data is imported into access, it is not in a normalized fashion. The first two columns of data are date ranges, the third is a location code, the remaining 54 columns hold specific data for each location. I need to find the top five values for each record so I can put them into a report.
I had posed this question in another thread, but was unable to find a solution. In that thread, someone recommended that I used a union query. It appeared that it was going to work perfectly, but you can only use 50 unions in access and I have to many fields.
Now I am trying to use VB code in access to transpose the table. I am working with the following code that I retrieved from this page. It is throwing an error on execution. I cannot figure out what the issue is. I know it is a syntax error or creating the object, but I have tried everything I can think of and cannot get it to work. Also, The column headers would contain string info so I was going to change the variable to a variant instead of an integer? Any help with this code, or suggestions regarding how to get what I want from the table would be appreciated.
Picture of actual table.
I am getting a error -> 'Run-time error '3265': Item not found in this collection.
Private Sub Command78_Click()
Const cstrInputTable = "Base Period OT"
Const cstrOutputTable As String = "Normalized Base Period OT"
Dim dbs As DAO.Database
Dim rstInput As DAO.Recordset
Dim rstOutput As DAO.Recordset
Dim intYear As Integer
Set dbs = CurrentDb
Set rstInput = dbs.OpenRecordset(cstrInputTable)
Set rstOutput = dbs.OpenRecordset(cstrOutputTable)
If Not rstInput.EOF Then
' For each column in the Input table, create a record in the output table
For intYear = 1990 To 2011
rstInput.MoveFirst
rstOutput.AddNew
rstOutput![Year] = intYear
' Go through every record in the Input table
Do
rstOutput(rstInput![Data Type]) = rstInput(CStr(intYear))
rstInput.MoveNext
Loop Until rstInput.EOF
rstOutput.Update
Next intYear
End If
rstInput.Close
rstOutput.Close
dbs.Close
MsgBox "Data Successfully Transformed"
DoCmd.OpenTable cstrOutputTable
End Sub
Still not sure I have fully understood your inputs and outputs. I'll give it a try though and you let me know if I'm even close to what you're looking for.
You can create a "Temp" table with only 3 fields just for sorting purposes. You can then loop through your source table and add Location, Column header (3 letter code) and the value of each field to the "Temp" table.
You can then sort by value DESC and select the top 5.
Public Sub GetTopFive()
On Error GoTo ErrProc
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Location, AMR, AXT, BRM, BMM, CSR, CTC " & _
"FROM DataSource ORDER BY Location;", dbOpenSnapshot)
If rs.EOF Then GoTo Leave
With rs
.MoveLast
.MoveFirst
End With
Dim idx As Long
For idx = 1 To rs.RecordCount
AddToTempTable rs
'Now the Temp table holds one Location, sorted by value
'Selecting the top 5 records will give you what you're looking for
'If that's the case, provide additional info on how to handle this
'as each location might have different field names.
rs.MoveNext
Next idx
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
'Add To Temp for sorting
Private Sub AddToTempTable(rs As DAO.Recordset)
Dim fld As DAO.Field
For Each fld In rs.Fields
If fld.Name <> "Location" Then
With CurrentDb.QueryDefs("qryAddToTemp")
.Parameters("[prmLocation]").Value = rs!Location
.Parameters("[prmFileldName]").Value = fld.Name
.Parameters("[prmFieldValue]").Value = fld.Value
.Execute dbFailOnError
End With
End If
Next fld
End Sub
Import query
PARAMETERS [prmLocation] Text ( 255 ), [prmFileldName] Text ( 255 ), [prmFieldValue] IEEESingle;
INSERT INTO tbTemp ( Location, [Field Name], [Field Value] )
SELECT [prmLocation] AS Location, [prmFileldName] AS [Field Name], [prmFieldValue] AS [Field Value];
Temp Table
Update:
Public Sub GetTopFive()
On Error GoTo ErrProc
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Location, AMR, AXT, BRM, BMM, CSR, CTC " & _
"FROM DataSource ORDER BY Location;", dbOpenSnapshot)
If rs.EOF Then GoTo Leave
With rs
.MoveLast
.MoveFirst
End With
Dim rsTemp As DAO.Recordset, fld As DAO.Field, idx As Long
Set rsTemp = CurrentDb.OpenRecordset("tbTemp")
With rsTemp
For idx = 1 To rs.RecordCount
For Each fld In rs.Fields
If fld.Name <> "Location" Then
.AddNew
.Fields("YourCodeColumnName").Value = fld.Name
.Fields(rs!Location).Value = fld.Value
.Update
End If
Next fld
rs.MoveNext
Next idx
End With
Leave:
On Error Resume Next
rsTemp.Close
Set rsTemp = Nothing
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
Based on what you have provided there are 6 possibilities of where you are getting error 3265, and 4 of them have the same solution, once you understand how DAO Recordset objects work and reference fields in the "Table" they represent.
The error Item not found in this collection, given the code you have presented indicates that you are referencing a field name (column name) in the recordset that does not exist. Or, that you are referencing a table name that does not exist in the database.
Since your code is dynamically determining field names, and you haven't provided the structure of the tables Base Period OT or Normalized Base Period OT, you will have to figure part of this out on your own.
Here are the 4 places where the error could be occurring for the Recordset objects and what you are looking for:
rstOutput![Year] = intYear, you are telling Access that you expect a column named "Year" to exist in your table Normalized Base Period OT and that you want to insert the current value of intYear into that column. If "Year" is not a column name in that table, this would be the problem.
3, & 4. rstOutput(rstInput![Data Type]) = rstInput(CStr(intYear)) In this single line of code, you have 3 possible locations for the error.
a. rstInput![Data Type] Does the table Base Period OT contain a column named "Data Type"? If not, this would be an error. Here you are statically providing the name of the column that you expect to exist in the input table.
b. rstOutput(rstInput![Data Type]) Assuming that rstInput![Data Type] is a valid column, the value in that column is now the name of the column you are expecting to exist in Normalized Base Period OT. If that is not true, this would be an error. Here, you are dynamically providing the name of the column that you expect to exist in the output table.
c. rstInput(CStr(intYear)) Does the table Base Period OT contain a column for the current value of intYear (i.e. does that table contain columns named 1990, 1991, 1992, etc through 2011 as defined in your loop?) If not, this would be an error. Here, again, you are dynamically providing the name of the column that you expect to exist in the input table.
5 & 6. You could also receive this error on your OpenRecordset commands if the tables, named in your two constants don't exist.
This addresses the issue with your code sample, but does not address whether your approach to transform the data for your other stated purposes is correct or not as we do not have enough additional information.
I'm working with DAO recorsets, the basic idea is to populate one table with records many times as the given argument indicates (limit).
It appears to work, but suddenly when I want to use the form again, it throws 3022 error. When I see table values, none of them is duplicated. I delete all records from that table and refresh table and form. The table doesn't show any value until I refresh the form. The unique value that is shown is the last value i try to save in database.
Here is a little bit of code:
Private Sub add_element(loops_number As Double)
i = 1
While (i < CDbl(loops_number))
function
i = i + 1
Wend
End Sub
That is working apparently fine.
Private Sub populate()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim last As DAO.Recordset
Set db = CurrentDb()
Set rst = db.OpenRecordset("Element", dbOpenTable)
Set last = rst.Clone
With rst
.AddNew
If (last.RecordCount <= 0) Then
'here I pass input form values to recordset fields ,because its the first row
last.Close
.Update
.Close
Else
last.MoveLast
!Pk = Custom_pk 'Custom_pk is obtained with a function --- not relevant
'here I pass remain values from last record to a new one --- because records has the same attributes
last.Close
.Update
.Close
End If
Set rst = Nothing
Set ultimo = Nothing
End With
End Sub
It's like last record values stays "active" after function finish work. I don't get why this happens.
Element pk is alphanumeric e.g. : "A1", then I build a function that separates A from 1,add +1 to number and concatenate values again, so the result is "A2"
I resolved it using an Autonumber field as primary key keeping the original pk (alphanumeric) as a common field then I could mantain my vba code exactly like I wanted it.
The issue is simple but I just cant figure it out.
I have two tables in access, one with records and another with "key words". I need to filter the records containing certain "key words". In other words, use one table field as a filter criteria for the other, but without linking them because the "key words" table just contains random words instead of a whole record.
In excel I can run an advanced filter on my records and just specify as criteria the list of key words (and using wildcards), but in acces I havent found a way to filter according to another table fields.
Any ideas about it?
You may need to create a function that spits out custom SQL with all the keywords in it. Here is an example to get you started.
Public Function fGetTrashRecords()
'add your own error handling
Dim SQL As String
Dim rst As DAO.Recordset
Dim rstTrash As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT sKeyWord FROM tblBadKeyWords", dbOpenSnapshot)
If Not rst Is Nothing Then
rst.MoveFirst
Do While Not rst.EOF
SQL = SQL & " strFieldContaingKeyWord LIKE *'" & rst!sKeyWord & "'* OR"
rst.MoveNext
Loop
If SQL > "" Then SQL = Left(SQL, Len(SQL) - 2) 'get rid of the last OR
rst.Close
Set rst = Nothing
End If
If SQL > "" Then
Set rstTrash = db.OpenRecordset("SELECT * FROM tblHasKeyWords WHERE " & SQL, dbOpenDynaset, dbSeeChanges)
If Not rstTrash Is Nothing Then
rstTrash.MoveFirst
Do While Not rstTrash.EOF
Debug.Print rstTrash!ID
rstTrash.MoveNext
Loop
rstTrash.Close
Set rstTrash = Nothing
End If
End If
Set db = Nothing
End Function
I have a crosstab query that is being loaded into a recordset. I'm then writing the query fields to an Excel spreadsheet. The problem is that a field may not exist based on the query results.
For example, I have the following line:
oSheet5.Range("F1").Value = rsB2("AK")
...which would write the value of the recordset item named "AK" to the spreadsheet. But if "AK" doesn't exist, I get an error Item not found in this collection.
How I can I test to see if there's an item named "AK"?
I tried...
If rsB2("AK") Then
oSheet5.Range("F" & Count).Value = rsB2("AK")
End If
...but that didn't work.
I also tried...
If rsB2("AK") Is Nothing Then
oSheet5.Range("F" & Count).Value = ""
Else
oSheet5.Range("F" & Count).Value = rsB2("AK")
End If
...and still the same error.
There are 50+ items/fields to check .. all states in USA plus a few extras.
Thanks!
You can use Recordset.FindFirst Method (DAO) take a look here or here
Small example:
Sub FindOrgName()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
'Get the database and Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblCustomers")
'Search for the first matching record
rst.FindFirst "[OrgName] LIKE '*parts*'"
'Check the result
If rst.NoMatch Then
MsgBox "Record not found."
GotTo Cleanup
Else
Do While Not rst.NoMatch
MsgBox "Customer name: " & rst!CustName
rst.FindNext "[OrgName] LIKE '*parts*'"
Loop
'Search for the next matching record
rst.FindNext "[OrgName] LIKE '*parts*'"
End If
Cleanup:
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Sub
You could add an error handler to catch the item not found error ... ignore it and/or do something else instead.
Or if the first recordset field always maps to the first sheet column regardless of the field's name, you can reference it by its ordinal position: rsB2(0)
Or you could examine the recordset's Fields collection to confirm the field name is present before attempting to retrieve its value.
After you open the recordset, load a dictionary with its field names. This code sample uses late binding. I included comment hints in case you want early binding. Early binding requires you to set a reference for Microsoft Scripting Runtime.
Dim objDict As Object 'Scripting.Dictionary
'Set objDict = New Scripting.Dictionary
Set objDict = CreateObject("Scripting.Dictionary")
Dim fld As DAO.Field
For Each fld In rsB2.Fields
objDict.Add fld.Name, vbNullString
Next
Then later you can use the dictionary's Exists method to your advantage.
If objdict.Exists("AK") = True Then
oSheet5.Range("F1").Value = rsB2("AK")
End If