Exporting an array of custom objects into Access table - ms-access

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

Related

VBA Updating table from multiple sources - incorrect data saved

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

Access VBA DAO | ADO Bloating Database on MakeTable Query

I have a process that updates an Access Database from Oracle data three times a day to get latest information. Current production process involves:
Create New Access Table (t1) of Most Current Data
Move Previous Version of Data to backup version (t to t2)
Move Current Data to Main table (t1 to t)
The reason it's done this way is in case the current data fails, users can still access earlier version of data until we can troubleshoot current data or until the next run.
There are many of the processes that we inherited and I am refactoring the process so we can trap and alert errors and stop downstream processes from running when earlier processes fail.
I've developed the following function using DAO so that I can take advantage of Execute to trap errors and bow out of the whole process gracefully. However, this process bloats the database greatly and in all my searching I cannot find a way around this. Most of the research I have done points to clearing out DAO.Recordsets and DAO.QueryDefs, neither of which I deal with in the DDL statements. I created a similar function with ADO as well, but the same issue persists.
Is there any way to clear the temp memory created in Access from this statements after executing so the code can continue without have the DB grow beyond 2GB size limit? Or perhaps it's just better to run the queries with DoCmd.RunSQL and build error trapping with GoTo. I'd like to avoid this but will settle on this if it's the only way.
Function below:
Function ExecuteSQL(db As DAO.Database, sQuery As String) As Boolean
'*******************************************************************
'** Sub: ExecuteSQL
'** Purpose: Stores current copy of Daily Eff Date table from Daily Eff Table1 and backs up previous version in Daily Eff Date2
'** Notes: Requires reference to Microsoft DAO 3.6 Object Library (or equivalent)
'*******************************************************************
Dim wSpace As DAO.Workspace
Set wSpace = DBEngine.Workspaces(0)
On Error GoTo ErrHandler
With wSpace
.BeginTrans
db.Execute sQuery, dbFailOnError
.CommitTrans
ExecuteSQL = True
End With
LeaveExecuteSQL:
wSpace.Close
Exit Function
ErrHandler:
wSpace.Rollback
Resume LeaveExecuteSQL
End Function
Here is an example of how Function is called.
If Not ExecuteSQL(CurrentDb, "Daily Sub ALL") Then 'Bring Submission Data into Access
strSubject = "ERROR in Creating The Daily Effective Date Table"
GoTo LeaveRunProcess
End If
Here is SQL for Daily Sub ALL:
SELECT PRODCT_EFF_DT, Left([DWCFEUL5_DEV_SUB_RPT_STATUS_SUBM_ALL_NM]![PRODUCT_SIC_CD],4) AS Expr1, Left([PRODUCT_SIC_CD],4) AS [SIC Short], INS_RQMT_PRODCT_NO, CMPNY_REGN_NM, PROCESSING_REGION, PROCESSING_RGN_NM, CMPNY_CD, CMPNY_NM, PUC_NAME, UW_REGION_NAME, PUC_NO, CLIENT_NAME, CLIENT_NUMBER, ACCOUNT_NUMBER, DUNS_NUMBER, DUNS_PARENT, PRODUCER_NUMBER, PRODUCER_NAME, PRODUCER_CONTACT, PRODCR_CNTCT_PRSN_NO, PRODUCT_TYPE, BRANCH_TYPE, BRANCH_NAME, DEPT_NO, NEW_DEPT_NO, DEPT_CD, DEPT_NM, NEW_DEPT_NM, NEW_PRFT_CENTR_NO, PROFT_CNTR_NM, NEW_PRFT_CENTR_NM, EXP_POLICY_NO, EXPPOLICYNO10, POLICY_NO, POLICYNO10, PRODCT_ATCHMT_PNT_AMT, DED_AMT, LMT_AMT, PRODCT_EXP_DT, QUOTE_BY_DT, PRODCT_DESIRBLTY, NEW_PRODCR_NM, PRODCT_SUCCESS_CHNC, WIN_CARR_NAME, INCUMBENT_INS_CARR, PRODCT_EFF_MONTH, LINE_OF_BUSINESS, PRODCT_NO, PROFIT_CENTER, EXP_PREMIUM, UNDERWRITER_NAME, EMPL_ID, STATE, LAST_UPDT_TS, PREM_AMT, DT_RECEIVED, DT_RESERVED, DT_ASSIGNED, DT_WORKING, DT_QUOTED, DT_BOUND, DT_ISSUED, DT_BOOKED, DT_MAILED, DT_DECLINED, DT_QUOTE_NOT_WRITTEN, CURR_STATUS, CURR_STATUS_CD, CURR_STATUS_CHG_USR, CURR_STATUS_EFF_DT, UW_ASISTANT_NAME, COMPANY_TYPE, CREATE_DT, CREATE_USR, PRM_FINCG_IND, BNKRPCY_STAT_CD, BRKR_MNSCRPT_FORMS_IND, UNDLYG_CNF_WRITN_IND, PRODUCT_SIC_CD, ACCT_SIC, ACCT_SIC_DESC, ACCT_SIC_PCT, PROG_TYP_CD, EXT_REPT_IND, MOT_TRK_LIAB_FIL, MOT_TRK_CRG_FIL, SUBJ_TO_AUDIT, COMP_RATED_IND, CONSENT_TO_RATE, IND_RISK_RATING, NY_FREE_TRD_ZONE, EPOL_DELIVERED, PAYDEX_SCORE, CREDIT_SCORE, FINANCIAL_STRESS_SCORE, YEARS_IN_BUSINESS, DNB_NO, DNB_NAME, DNB_PARENT_NO, DNB_HEADQUARTERS_NO, DNB_ADDRESS_LINE1, DNB_ADDRESS_LINE2, DNB_ZIPCODE, DNB_CITY, DNB_STATE, DNB_COUNTRY_CODE, COMMERCIAL_CREDIT_SCORE, START_YEAR, CURRENT_CONTROL_YEAR, NAICS_CODE, INSRD_NM, PRODCR_LONG_NAME, SIR_AMOUNT, EMAIL_ADDRS_TXT, SUB_PRODUCER_NO, SUB_PRODUCER_CODE, SUB_PRODUCER_NM, SUB_PRODUCER_ADDRESS_LINE1, SUB_PRODUCER_ADDRESS_LINE2, SUB_PRODUCER_ADDRESS_LINE3, SUB_PRODUCER_CITY, SUB_PRODUCER_STATE, SUB_PRODUCER_ZIPCODE, PRODUCER_PHONE_NO, SHOPPING, ASSOC_NO, VIABILITY_SCORE, POLICY_ISSUED_BY, ASSOCIATE_UW, FEIN_N0, PRODUCER_FEIN
INTO [Daily Eff Date1]
FROM DWCFEUL5_DEV_SUB_RPT_STATUS_SUBM_ALL_NM
WHERE (((PRODCT_EFF_DT)>#1/1/2015#) AND ((NEW_PRFT_CENTR_NM) Not Like "Hawaii"));
NOT AN ANSWER SUPPORT FOR COMMENT
Option Compare Database
Private WithEvents conCUSTOM_CONNECTION As ADODB.CONNECTION
Public Event evtEXECUTEERROR(ByVal pError As ADODB.Error)
Public Event evtEXECUTESUCCESS()
Public Sub INITIALISE_CONNECTION(con As ADODB.CONNECTION)
Set conCUSTOM_CONNECTION = con
End Sub
Private Sub conCUSTOM_CONNECTION_ExecuteComplete(ByVal RecordsAffected As Long, _
ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, _
ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, _
ByVal pConnection As ADODB.CONNECTION)
If pError Is Nothing Then
RaiseEvent evtEXECUTESUCCESS
Else
RaiseEvent evtEXECUTEERROR(pError)
End If
End Sub
I have encountered the same issue where my database is bloating on raw data import. VBA is not allowed to call Compact & Repair on a non-split database. Instead of splitting the database and compacting the backend routinely, I decided to use the database object (DAO) to create a temp database, import the data, query from that temp database back to original and then delete the temp database. Base code shown below:
Sub tempAccessDatabaseImport()
Dim mySQL As String
Dim tempDBPath As String
Dim myWrk As DAO.Workspace
Dim tempDB As DAO.Database
Dim myObject
'Define temp access database path
tempPathArr = Split(Application.CurrentProject.Path, "\")
For i = LBound(tempPathArr) To UBound(tempPathArr)
tempDBPath = tempDBPath + tempPathArr(i) + "\"
Next i
tempDBPath = tempDBPath + "tempDB.accdb"
'Delete temp access database if exists
Set myObject = CreateObject("Scripting.FileSystemObject")
If myObject.FileExists(tempDBPath) Then
myObject.deleteFile (tempDBPath)
End If
'Open default workspace
Set myWrk = DBEngine.Workspaces(0)
'DAO Create database
Set tempDB = myWrk.CreateDatabase(tempDBPath, dbLangGeneral)
'DAO - Import temp xlsx into temp Access table
mySQL = "SELECT * INTO tempTable FROM (SELECT vXLSX.*FROM [Excel 12.0;HDR=YES;DATABASE=" & RAWDATAPATH & "].[" & WORKSHEETNAME & "$] As vXLSX)"
'DAO Execute SQL
Debug.Print mySQL
Debug.Print
tempDB.Execute mySQL, dbSeeChanges
'Do Something Else
'Close DAO Database object
tempDB.Close
Set tempDB = Nothing
myWrk.Close
Set myWrk = Nothing
'Delete temp access database if exists
If myObject.FileExists(tempDBPath) Then
'myObject.deleteFile (tempDBPath)
End If
End Sub
This should probably only be a comment, but I don't have the privileges for that.
"Compact & Repair"ing a database will help with size issues. You can use the Access visual interface to do that on a regular basis or programatically:
https://msdn.microsoft.com/en-us/library/office/bb220986(v=office.12).aspx
Compressing the file (only works on NTFS) will reduce the physical hard drive space occupied (as with ZIP or RAR) while improving speed with hard-drive access (fewer spins in the case of hard disks, and less bytes to read). You can even apply NTFS compression to a file on a network share.
Just today I further reduced the size of an Access database by simply copying all of the objects (it only consists of tables) to a new database file. So it became several times smaller even though I had already compacted it.
I said it's only a comment since it only helps, not solve every side of the problem in every way.
If you can, using append queries instead of make table ones might be worth trying too.

Inserting records in MS Access by means of macros

Good evening!
At this moment I'm learning to work in MS Access for my job purposes. I gained some understanding of the program's basics, such as creating tables or making easy forms (though not yet working ideally), and by now I've got stuck in solving the following task.
I have a database BooksDatabase, which consists of three tables: Books, Authors and AuthorsInfo. First one contains information about books (name, genre, country, release year etc.), third one is about authors (first name, last name etc.) and the second one links ever book with its author(s). The task is to import data from text file to those tables, so that it would be almost automatic. I understand how to import files to MS Access (at least, the ones of *.txt extension) and I do this into the table BooksToImport, but I have some difficulties with inserting imported data. Here is the code of my function ImportBooks(), which I execute from macros of the same name:
' Procedure which imports data about books from the table BooksToImport
Function ImportBooks()
Dim dbBooks As Database
Dim rstImBooks, rstBooks, rstAuthors, rstBALink As DAO.Recordset
Dim codeI, codeB, codeA, codeL As Variant
'initializing database
Set dbBooks = CurrentDb
Set rstImBooks = dbBooks.OpenRecordset("Query_BooksToImport",dbOpenDynaset) 'receiving data from query
'checking if the query has any records
If rstImBooks.RecordCount = 0 Then
MsgBox "There are no records for importing!", vbInformation, "Attention!"
rstImBooks.Close
Set dbBooks = Nothing
Exit Function
End If
'if it's OK, we're making a loop on query's records
rstBooks = dbBooks.OpenRecordset("Books",dbOpenDynaset)
rstAuthors = dbBooks.OpenRecordset("AuthorsInfo",dbOpenDynaset)
rstBALink = dbBoks.OpenRecordset("Authors",dbOpenDynaset)
rstImBooks.MoveLast
rstImBooks.MoveFirst
Do While rstImBooks.EOF = False
'checking if there is a book in out database with the same name as in imported data
codeB = DLookup("[ID]","[Books]","[BookName] = '" & rstImBooks![BookName] & "'")
If IsNull(codeB) Then
'inserting new record
With rstBooks
.AddNew
![BookName] = rstImBooks![BookName]
.Update
.Bookmark = .LastModified
codeB = ![ID]
End With
End If
'in much the same way we're treating the data about authors and making the links
rstImBooks.MoveNext
Loop
rstImBooks.Close
rstBooks.Close
rstAuthors.Close
rstBALink.Close
Set dbBooks = Nothing
End Function
I have two problems with this function:
method .AddNew for rstBooks is not working — MS Access shows me a message with error 438 ("Object doesn't support this property or method");
also I cannot assign variable rstBALink to the recordset because compiler says "Invalid use of property".
So my question is this: how should I solve these two problems? What do I do wrong that my function is not working properly?
A few issues with your code that I see. These may or may not fix your problem.
Your declarations are implicit, meaning you aren't being specific with your code about what your recordset objects are. Instead of using:
Dim rstImBooks, rstBooks, rstAuthors, rstBALink As DAO.Recordset
Try:
Dim rstImBooks As DAO.Recordset
Dim rstBooks As DAO.Recordset
Dim rstAuthors As DAO.Recordset
Dim rstBALink As DAO.Recordset
You can put them all on one line separated by commas, but you still need to declare the type for each or Access will assume it's a variant.
Secondly, recordset objects need to be created using the Set keyword, not by using an = alone.
This was done correctly in the top portion of your code, but is incorrect here:
rstBooks = dbBooks.OpenRecordset("Books",dbOpenDynaset)
rstAuthors = dbBooks.OpenRecordset("AuthorsInfo",dbOpenDynaset)
rstBALink = dbBoks.OpenRecordset("Authors",dbOpenDynaset)
Should be:
Set rstBooks = dbBooks.OpenRecordset("Books",dbOpenDynaset)
Set rstAuthors = dbBooks.OpenRecordset("AuthorsInfo",dbOpenDynaset)
Set rstBALink = dbBooks.OpenRecordset("Authors",dbOpenDynaset)
I think that will solve your issues, but I didn't review every line of your code admittedly. Let me know if you still have problems.
EDIT:
Found a typo:
rstBALink = dbBoks.OpenRecordset("Authors",dbOpenDynaset)
Should be:
Set rstBALink = dbBooks.OpenRecordset("Authors",dbOpenDynaset)
(missed an 'o' in dbBooks)

why MS Access2013 is giving "you must enter a value in 'Desc' field" when there is a value already?

I'm new to MS Access and Sharepoint. I've a requirement to link to a sharepoint list within Access (2013) and Insert new record in this linked table (the table which gets created in the Access when we link the sharepoint list). The linked table has multivalued columns. So I'm using the recordset approach to run the INSERT query. Below is what I'm doing.
Option Compare Database
Sub Insert_Query()
Dim dbs As DAO.Database
Dim rs_parent As DAO.Recordset2
Dim rs_child As DAO.Recordset2
Set dbs = CurrentDb
Set rs_parent = dbs.OpenRecordset("TABLENAME")
With rs_parent
.AddNew
![T1] = "test_title"
![W1] = "test_w"
![P1] = "Low"
![A1] = "saleem, Shaik"
![Desc] = "test description" 'LongText type field 'Required Field
Set rs_child = rs_parent![Assigned To].Value
With rs_child
rs_child.AddNew
rs_child!Value = 3160
rs_child.Update
rs_child.Close
End With
rs_parent.Update 'Getting run time error 3314(You must enter a value in 'Desc' Field) on this line
rs_parent.Close
End With
End Sub
I've tried changing rs_parent![Desc] to rs_parent.Fields("Desc") and rs_parent.Fiedls(7)---> 7 is the item number in that collection, but all of them are giving the same error.
Any idea what could be the reason for the error and how to fix it please? Feel free to ask me if you need any further information.
Edit: The above error comes only when I execute the procedure when Access is 'online with Sharepoint'. But The same code works just fine if I convert the TABLENAME into a local table and execute the procedure.

How to check if table exists in MySql db?

I have a VB6 application and I want to check if a table exists within a MySQL database on phpmyadmin. In reality the table is actually a view however it should act exactly as it's own table.
The code I currently have constantly returns false?
I think my problem might have to do with the variable cnDataStoreToVerify because when I try to print its Contents it only contains:
"Provider=MSDASQL.1;" ?
Help would be much appreciated!
Public Function TableExists(cnDataStoreToVerify As ADODB.Connection, strTableName as String) As Boolean
Dim recTemp As ADODB.Recordset
Set recTemp = cnDataStoreToVerify.OpenSchema(adSchemaTables, Array(Empty, Empty, StrTableName, Empty))
If Not recTemp.EOF Then
TableExists = True
End If
Exit_TableExists:
m_oADOUtils.CloseRecordsetADO recTemp
End Function