VBA Updating table from multiple sources - incorrect data saved - ms-access

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

Related

creating a document database

I camse across an old post which had the pefect solution for my requirement - 'Creating a Document Database Using Microsoft Access' with the answer provided by Renaud BomPuis in the form of a sample database (https://dl.dropboxusercontent.com/u/52900980/StackOverflow/SO25044339.accdb).
I have been able to manipulate the source code for this to suit my needs and successfully insert it into my main database. The only problem I have is that it creates a new record at the wrong point for me. When the user clicks 'Upload File' a new record is created and a form opens to be able to select the file using file dialog. But if the user changes their mind and clicks cancel, the record is already created but empty of a file path.
I would like to be able to only create a new record if the user confirms it but I cannot seem to manipulate the code into the correct order for it to work.
Can anybody help please? Many thanks.
EDIT: Code from comment
Private Sub btnUploadDoc_Click() ' Create a new record in the Documents table for the selected Works No
Dim DocID As Variant
Dim db As dao.Database
Dim rs As dao.Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblDocuments", dbOpenDynaset, dbFailOnError)
With rs
.AddNew !WorksNo = cboWorksNo
.Update
.Move 0, .LastModified
DocID = !DocID
.Close
End With
Set rs = Nothing
Set db = Nothing
DoCmd.OpenForm "frmDocSelect", WhereCondition:="DocID=" & DocID
End Sub
This will not be a trivial change, since (I assume) frmDocSelect depends on an existing record in tblDocuments.
The best way to proceed is probably to simply delete the new record if the user clicks Cancel.
Something like
Sub cmdCancel_Click()
Dim DocID As Long
DocID = Me.DocID
' Close form before deleting, to avoid a flicker of "#Deleted"
DoCmd.Close acForm, Me.Name, acSaveNo
CurrentDb.Execute "DELETE * FROM tblDocuments WHERE DocID=" & DocID
End Sub

Access - custom "was unable to append all data to table"?

I created code for importing data from Excel into desired table, via TransferSheet and builded Query method. I'm also trying to resolve all errors that User could do when Importing data into db (wrong file format, appending 0 rows,field names not same as in DB etc.), but cannot get rid of Error 3059 "was unable to append all data to table" - It occurs when you try to Import some invalid data. I want a custom Msgbox for this error, and stop executing my Query. Here's my code - in short :
Private Sub CmdImport_Click()
Dim SQL As String
Dim dbs As DAO.Database
Set dbs = CurrentDb
On Error GoTo ERR1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "NEWTABLE", "<Imported file>", True
SQL = " INSERT INTO MyTable (Field1)" & _
" SELECT DISTINCT" & _
" FROM NEWTABLE"
DoCmd.SetWarnings False
dbs.Execute SQL
DoCmd.RunSQL "DELETE * FROM NEWTABLE"
DoCmd.SetWarnings True
ERR1:
If Err.Number = 3059 Then
MsgBox "This file doesn't have proper data to import. Import canceled !"
Exit Sub
End If
End Sub
This code pops-up custom Msgbox after Access allready opens built-in window, regardless of DoCmd.SetWarnings False. If I move DoCmd.SetWarnings False before TransferSheet method, import gets executed and no Msgbox is displayed - which is wrong. How can I handle this error, anybody knows ??
You could import to a temp table.
Then read this with a query that converts and cleans the data, and use this query for your further processing - which now will run without errors caused by malformed data.
I have figured out another way to solve this. I have put all controls that I need before DoCmd.TransferSheet method, including eliminating error that causes "was unable to append all data to table". I added code for checking excel file, and If Excel file data doesn't match criteria, DoCmd.TransferSheet is not performed - so therefore error "was unable to append all data to table" doesn't appear at all. Here It is (part of code which first checks If Excel file data is proper to perform DoCmd.TransferSheet import) :
Dim XcelApp As Object
Dim x, i
Set XcelApp = CreateObject("Excel.Application")
XcelApp.ScreenUpdating = False
XcelApp.Workbooks.Open("C:\Users\Lucky\Desktop\Test\Sample.xlsx")
With XcelApp
i = XcelApp.Rows(1).Find(What:="Število", LookIn:=xlValues, Lookat:=xlWhole).Column
x = XcelApp.Range(XcelApp.Cells(1, i), XcelApp.Cells(XcelApp.Rows.Count, i).End(xlUp)).Value
For i = 2 To UBound(x)
If Not IsNumeric(x(i, 1)) Then
ExcelApp.Quit
Set ExcelApp = Nothing
MsgBox "This Excel file is not valid"
: Exit Sub
End If
Next i
End With
XcelApp.Quit
XcelApp = Nothing
Code is snapshop from this solved thread: loop through Excel columns

Why isn't MS Access "item found in collection?"

I have a non-linked table "tblGrantRptData" in which I am trying to modify field records for subsequent filtering and export to EXCEL. I have ensured that all field names are correctly spelled, yet I still get an Error 3265, Item not found in this collection.
I have confirmed that MemmonthlyIncome is the correct spelling and is identified in the design as "currency."
here is the design veiw that appears to show the field name:
It stops at this line:
If IsNull (!MemmonthlyIncome) Then
with the error 3265
If I can get some help to resolve this, I would then like to store the range "0-30"....
One suggestion below was to “decompile" and "recompile.” I have read that this may cause problems when the database is used on multiple workstations. I have revised the code to just get to first base….Any suggestions?
Private Sub cmdGenerateGrantRpt_Click()
'now run the qqAll query - this generates the tblGrantRptData - then close the query
DoCmd.SetWarnings False
DoCmd.OpenQuery "qqAll", acViewNormal, acEdit
DoCmd.Close acQuery, "qqAll"
DoCmd.SetWarnings True
'First set up the table: tblGrantRptData with the correct data in fields
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tblGrantRptData", dbOpenTable)
'Check to see if the recordset actually contains rows and fill in particular values
With rs
If .EOF And .BOF Then
MsgBox "There are no records in this time interval"
Exit Sub
Else
.MoveFirst
Do Until .EOF = True
'Replace the monthly income with income categories
If IsNull(!MemmonthlyIncome) Then
.Edit
!MemmonthlyIncome = "0-30"
.Update
End If
Loop
End If
End With
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
End Sub
You get error #3265, "Item not found in this collection", at IsNull(!MemmonthlyIncome) in this context ...
Set rs = db.OpenRecordset("tblGrantRptData", dbOpenTable)
With rs
If IsNull(!MemmonthlyIncome) Then
That would happen if tblGrantRptData does not include a field named MemmonthlyIncome. What you are seeing as the column heading in the table Datasheet View may be the field's Caption property. You could check the field's Name and Caption properties in the table's Design View. Or you could list the actual field names for your table in the Immediate window.
Here's an abbreviated list of the field names in my Contacts table:
set db = currentdb
for each fld in db.TableDefs("Contacts").Fields : ? fld.name : next
ID
Company
Last Name
First Name
You just added this screen capture of your table in Design View ...
Notice the field is named MemmothlyIncome, not MemmonthlyIncome (moth vs. month). So it wasn't a Name vs. Caption difference after all; you simply tried to use a misspelled field name. That spelling problem is also visible in the DataSheet View screen capture, but we didn't notice it there.
In VBA, there is no Is Null expression as there is in SQL. Change to IsNull(rs!MemmonthlyIncome).
Possibly, Null is being referenced in recordset collection and hence returning the error.

Filter results in Microsoft Access 2010 Form using VBA

I am working on an Access Database where I need to display records from a table in a form as a datasheet. I believe I have correctly written the code to perform the filtering, but am not sure how to display the records.
I know that I can perform this easier using a query, and then a form based on those results, but wish to limit this process if at all possible, to reduce the overall size of the database. The filter will be sorting a company, and the fiscal dates.
Any help is appreciated.
Here is the code I have thus far...
Option Compare Database
Sub Form_Current()
Dim oTable As DAO.Recordset
Dim oDataNeedsGas
Dim dNextFiscal, dThisFiscal
Dim iGas
'Fiscal Year turnover date, use DateValue(dNextFiscal) comparison.
dNextFiscal = "10/1/" & Year(Date)
dThisFiscal = "10/1/" & Year(Date) - 1
'For Annual training by year comparison.
'Year(DateValue(oTable!randomdate)) >= Year(Date)
Set oTable = Application.CurrentDb.OpenRecordset("tbl_main", dbOpenDynaset)
iGas = 0
Do Until oTable.EOF = True
If (Year(DateValue(oTable![GasDate])) >= Year(Date) And oTable![Platoon] = "Data") Then
`What do I do here?!!?
iGas = iGas + 1
End If
msgbox iGas
oTable.MoveNext
Loop
End Sub
I know the filtering works, because I have it count the matched records, then display in a message box, but I want to be able to display the matched records. How do I go about doing this?
Make the RecordSource on your Datasheet from blank and then have this code run when the form loads:
Option Compare Database
Private Sub Form_Load()
Dim sSQL as String
sSQL = "SELECT * FROM tbl_Main "
sSQL = sSQL & "WHERE Year(DateValue(GasDate)) >= Year(Date) "
sSQL = sSQL & " AND Platoon = 'Data'"
Me.RecordSource = sSQL
MsgBox "RecordCount: " & Me.RecordCount
End Sub
I generally use the Form's RecordSource and the Forms Filter and FilterOn properties. You can always load the form showing all records and then filter down to what you want to see.
I didn't understand this line in your question:
"...but wish to limit this process if at all possible, to reduce the overall size of the database."
Are you trying to increase performance? Are you worried about storing too much data and the tables getting too large? That part of your question just isn't clear.
You can set your Subform's Recordset property to oTable. Make the recordset a property of the main form though, as shown in the following code, so that you can release this reference when the form closes.
Option Compare Database
Private oTable As Object
Private Sub Command2_Click()
Set oTable = Application.CurrentDb.OpenRecordset("tbl_main", dbOpenDynaset)
Set Me.sbfName.Form.Recordset = oTable
End Sub
Private Sub Form_Close()
If Not oTable Is Nothing Then
Set oTable = Nothing
End If
End Sub
For your specific example you would OpenRecordset based on a SQL statement that includes your date-criteria. I haven't tested whether this will be updateable, as it is for a Table. (I am getting the impression that it will not be updateable.)
It is possible to do this but I'm not suggesting it is a recommended approach. It is far easier to use the RecordSource property, filtering its records.
I want to emphasise that I would not use the Recordset of the subform. Use the RecordSource. You can set it to a SQL statement and/or filter records. Using the Recordset property is problematic (and unnecessary).

Exporting an array of custom objects into Access table

I have a timesheet system in excel with 3 rows (standard time, overtime, double time) for each of our (100+) employees, and one column for each cost code on the site. This ends up being a giant matrix, most of which is empty. My solution is to basically create an employee datatype which stores the employee information and hours for a single cost code.
Public Type Employee
Name As String
Trade(1 To 3) As String
EmpNum As Long
Comment As String
AddOns(1 To 3) As Single
Allowance(1 To 3) As Single
Contract As Long
CostCode As Long
STHours As Single
OTHours As Single
DTHours As Single
WorkDate As Date
End Type
I can process the spreadsheet and organize the information in excel as an array of employee-type objects, but I'm not familiar with how to export this into Access, and most questions relate to exporting from excel cells to Access. I can obviously put these objects into cells on another worksheet and do it that way, but it seems like there should be a better way.
Currently my best guess is something like this:
Insert data form Excel to Access 2010 using VBA
but then I'd be making 100+ updates to the table for each export.
Is there an efficient way to create a table object in VBA, populate it with the array information, and then append it to the end of my table in Access in a single update?
Thanks.
-Sean
The easiest way is to create a table link in Access. Table links look like tables in the rest of Access, but the data is stored externally. The data could be inside another Access database, or inside a SQL Server database, or what have you.
In particular, the data can be in an Excel spreadsheet. Define a table in Excel that contains the data in the format that's right for your Access application. Then build a table link in Access that links back to the table you defined in Excel.
When you update the Excel table, the updated results will automatically appear the next time you reference the table link in Access.
thanks for the help from everyone ... I just wanted to share what I came up with for a solution. I ended up building a function to insert one object into the database ... copied and modified from the interwebs. Code below, cheers!
Public Function InsertTimeRecord(EmpData As Employee) As Boolean
Dim SaveTime As Date
Dim db As DAO.Database
Dim rs As DAO.Recordset
'//Database Location
Const DB_LOCATION = "C:\access\KMP Tracker.mdb"
'//If errors occur the function will exit with a return value of false (insertion failed)
On Error GoTo ErrHandler:
'//Table has a datecreated/datemodified timestamp for each record
SaveTime = Now
'//Open Database
If db Is Nothing Then
Set db = DAO.Workspaces(0).OpenDatabase("C:\access\KMP Tracker.mdb") 'Removed DB_LOCATION
End If
'//Open Table
If rs Is Nothing Then
Set rs = db.OpenRecordset("Timesheet Data", dbOpenDynaset)
End If
'//Create a new record
With rs
.AddNew
![EmpName] = EmpData.Name
![Trade1] = EmpData.Trade(1)
![Trade2] = EmpData.Trade(2)
![Trade3] = EmpData.Trade(3)
![EmpNum] = EmpData.EmpNum
![Comment] = EmpData.Comment
![AddOns1] = EmpData.AddOns(1)
![AddOns2] = EmpData.AddOns(2)
![AddOns3] = EmpData.AddOns(3)
![Allowance1] = EmpData.Allowance(1)
![Allowance2] = EmpData.Allowance(2)
![Allowance3] = EmpData.Allowance(3)
![Contract] = EmpData.Contract
![CostCode] = EmpData.CostCode
![STHours] = EmpData.STHours
![OTHours] = EmpData.OTHours
![DTHours] = EmpData.DTHours
![WorkDate] = EmpData.WorkDate
![DateSubmitted] = SaveTime
'//Insert Record into Database
.Update
InsertMachineHoursRecord = True '//SUCCESSFUL INSERTION
End With
'//Note that we use recordset in this example, but equally effective
'// is to create an update query command text and simply run the update query:
'// (INSERT INTO Table (Field1, Field2) VALUES (Value1, Value2);
'//Make sure we have closed the database
My_Exit:
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description
Resume My_Exit
End Function