Gerw
asked on
automatic paste excel data to access
I am trying to automate a daily task of updating timeclock data from Excel to an Access database. I have tried to write the code but I am getting hung up immediately with an error "user-defined type not defined"
The data is from daily polling of the cash registers which hold the daily time clock data. It is opened in Excel for editing and formatting so as to be correct for the Access database table. Table is named "Z1_lab_e". Database is named "Snapshot". The records are currently being attached manually with a copy and paste append method.
I know as well that the method I am using to select the records to append is probably clumsy and may not even work. Much of the code is cobbled together from various sources, but I'm not sure if it is correct. The number of records vary from day to day depending on how many people work so the code must find the last record and paste them all.
The data is from daily polling of the cash registers which hold the daily time clock data. It is opened in Excel for editing and formatting so as to be correct for the Access database table. Table is named "Z1_lab_e". Database is named "Snapshot". The records are currently being attached manually with a copy and paste append method.
I know as well that the method I am using to select the records to append is probably clumsy and may not even work. Much of the code is cobbled together from various sources, but I'm not sure if it is correct. The number of records vary from day to day depending on how many people work so the code must find the last record and paste them all.
Sub Senddatatoaccess()
Dim db As Database
Dim rs As Recordset
Dim ws As Worksheet
Dim CurRow As Integer
Dim LastRow As Integer
Set db = DBEngine.Workspaces(0).OpenDatabase("c:\panpoll\snapshot.mdb")
Set ws = Worksheets("Sheet1")
Set rs = db.OpenRecordset("Z1_lab_e.dbf", dbOpenDynaset)
With rs
.AddNew
!T1F1 = ws.Cells(1, 1) ' data is in row 1, col 1
!T1F2 = ws.Cells(1, 2) ' data is in row 1, col 2
!T1F2 = ws.Cells(1, 3) ' data is in row 1, col 3
!T1F2 = ws.Cells(1, 4) ' data is in row 1, col 3
!T1F2 = ws.Cells(1, 5) ' data is in row 1, col 5
.Update
End With
rs.Close
LastRow = ws.UsedRange.Rows.Count
' loop through the rows
For CurRow = 2 To LastRow ' data starts in row 2
With rs
.AddNew
!T2F1 = ws.Cells(CurRow, 1)
!T2F2 = ws.Cells(CurRow, 2)
.Update
End With
Next CurRow
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
Set ws = Nothing
Would it be possible to give us an example of your spreadsheet. Make sure you don't have personal data. Just do an Attach file.
ASKER
i have attached an example of the file. This file is opened, checked for accuracy, copied and after the paste to Access, is deleted.
Thanks for looking at this.
getpayrolldata.xlsx
Thanks for looking at this.
getpayrolldata.xlsx
ASKER
Just to be clear, the database named "Shapshot" has a number of tables. The table I am working with for this process is called. "Z1_lab_e" and the fields in this table are "TDay" (date employee worked) "EmpID" which has their clock in number, "EmpName" (employee name) "Reg_Hr1" (regular hours worked), Ov_Hr1 (overtime hours worked) and "Store" (shows the store number of the employee whose hours we are entering)
Ok. This is Access 07 I take it? I haven't gotten there yet.
Looking at your spreadsheet it looks pretty basic, and can probably de done more easily using an Access 03 and down method.
You could link an Excel spread sheet in through code like it was a simple table. Then from there it was just a matter of doing an append query. You could wrap the import and a directory listing as one function, or feed it to the import function.
I'll still put out a request for some other experts with 07 experience to take a look. But this is Saturday Evening our time. Everyone is probably on their second cocktail. ;-)
Looking at your spreadsheet it looks pretty basic, and can probably de done more easily using an Access 03 and down method.
You could link an Excel spread sheet in through code like it was a simple table. Then from there it was just a matter of doing an append query. You could wrap the import and a directory listing as one function, or feed it to the import function.
I'll still put out a request for some other experts with 07 experience to take a look. But this is Saturday Evening our time. Everyone is probably on their second cocktail. ;-)
Public Function Import_Excel_Files()
Dim SQL As String
Dim FilePath As String
FilePath = "C:\MyPath\MyExcel.xls"
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, "MyLinkedExcel", _
FilePath, False
SQL = "INSERT INTO Z1_lab_e (TDay, EmpID, EmpName, Reg_Hr1, Ov_Hr1, Store) " & _
"SELECT * FROM MyLinkedExcel;"
DoCmd.SetWarnings False
DoCmd.RunSQL SQL
DoCmd.SetWarnings True
End Function
ASKER
Thanks for the work I would prefer to initiate this from Excel since opening Access to start the import sort of defeats the purpose. Once the database is open then it is a rather simple matter to open the table and click paste append to add the records. On the other hand, running some code from Excel to do the whole thing saves a number of steps. Did you try to see what was happening to cause the error in my original code?
Try with:
Set rs = db.OpenRecordset("Z1_lab_e ", dbOpenDynaset)
- and don't close rs until you are finished.
/gustav
Set rs = db.OpenRecordset("Z1_lab_e
- and don't close rs until you are finished.
/gustav
ASKER
I tried to organize the code differently using your suggestion and moving one line which sets the db so that it is prior to the open recordset declaration. Now the error I am getting is "object required". Any further suggestions?
Sub Senddatatoaccess()
Set db = DBEngine.Workspaces(0).OpenDatabase("c:\panpoll\snapshot.mdb")
Set rs = db.OpenRecordset("Z1_lab_e", dbOpenDynaset)
Dim ws As Worksheet
Dim CurRow As Integer
Dim LastRow As Integer
Set ws = Worksheets("Sheet1")
Set rs = db.OpenRecordset("Z1_lab_e.dbf", dbOpenDynaset)
With rs
.AddNew
!T1F1 = ws.Cells(1, 1) ' data is in row 1, col 1
!T1F2 = ws.Cells(1, 2) ' data is in row 1, col 2
!T1F2 = ws.Cells(1, 3) ' data is in row 1, col 3
!T1F2 = ws.Cells(1, 4) ' data is in row 1, col 3
!T1F2 = ws.Cells(1, 5) ' data is in row 1, col 5
.Update
End With
rs.Close
LastRow = ws.UsedRange.Rows.Count
' loop through the rows
For CurRow = 2 To LastRow ' data starts in row 2
With rs
.AddNew
!T2F1 = ws.Cells(CurRow, 1)
!T2F2 = ws.Cells(CurRow, 2)
.Update
End With
Next CurRow
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
Set ws = Nothing
End Sub
You are still closing the recordset.
/gustav
/gustav
ASKER
Okay, I commented out both lines which close the recordset, however when I step through the code it still returns an error on the first line. "Object Required". I am missing something here and cannot figure this one out.
Of course - you now have left out the dim of both db and rs.
And this line must be removed:
Set rs = db.OpenRecordset("Z1_lab_e .dbf", dbOpenDynaset)
/gustav
And this line must be removed:
Set rs = db.OpenRecordset("Z1_lab_e
/gustav
ASKER
I am getting more confused as I work through this. Still getting "object requiired" I removed the line "Set rs = b.OpenRecordset("Z1_lab_e. dbf",dbOpe nDynaset)" as suggested but it still is not working and I am unable to think this one through.
I have attached the code once again. If you have any suggestions about changes, please post them and I will give it a try.
.
I have raised the points to 500 as this seems more difficult than I first thought.
I have attached the code once again. If you have any suggestions about changes, please post them and I will give it a try.
.
I have raised the points to 500 as this seems more difficult than I first thought.
Sub Senddatatoaccess()
'Set Db = DBEngine.Workspaces(0).opendatabase("c:\panpoll\snapshot.mdb")
'Set rs = Db.OpenRecordset("Z1_lab_e", dbOpenDynaset)
'Dim dbSnapshot As DAO.Database
Dim ws As Worksheet
Dim CurRow As Integer
Dim LastRow As Integer
Set ws = Worksheets("Sheet1")
'Set rs = Db.OpenRecordset("Z1_lab_e.dbf", dbOpenDynaset)
With rs
.AddNew
!T1F1 = ws.Cells(1, 1) ' data is in row 1, col 1
!T1F2 = ws.Cells(1, 2) ' data is in row 1, col 2
!T1F2 = ws.Cells(1, 3) ' data is in row 1, col 3
!T1F2 = ws.Cells(1, 4) ' data is in row 1, col 3
!T1F2 = ws.Cells(1, 5) ' data is in row 1, col 5
.Update
End With
'rs.Close
LastRow = ws.UsedRange.Rows.Count
' loop through the rows
For CurRow = 2 To LastRow ' data starts in row 2
With rs
.AddNew
!T2F1 = ws.Cells(CurRow, 1)
!T2F2 = ws.Cells(CurRow, 2)
.Update
End With
Next CurRow
'rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
Set ws = Nothing
End Sub
But you didn't reinsert the Dim of db and rs. And you commented out even more lines ...
It will not work that way.
Take your original code.
This line should read:
Set rs = db.OpenRecordset("Z1_lab_e ", dbOpenDynaset)
And only the last rs.Close should be present.
/gustav
It will not work that way.
Take your original code.
This line should read:
Set rs = db.OpenRecordset("Z1_lab_e
And only the last rs.Close should be present.
/gustav
ASKER
We are getting closer. The "object required" error is gone now (perhaps because I checked the box for references "Microsoft Access 3.0 Type Library") . The next problem is that I lose focus on the current worksheet in Excel in order for the code to pick up the record data. Do I need to declare Excel in some way in order to reference the worksheet and pick up the data?
Here is the code that works down to the point where it starts to read the data.
i.e. "Set ws = Worksheets("Sheet1")
The error I get is Runtime error 9 Subscript out of range.
Thanks again.
Here is the code that works down to the point where it starts to read the data.
i.e. "Set ws = Worksheets("Sheet1")
The error I get is Runtime error 9 Subscript out of range.
Thanks again.
ASKER
forgot to attach code
Sub Senddata()
Set db = DBEngine.Workspaces(0).opendatabase("c:\panpoll\snapshot.mdb")
Set rs = db.OpenRecordset("Z1_lab_e", dbOpenDynaset)
'Dim dbSnapshot As DAO.Database
Dim wb As Workbook
Dim ws As Worksheet
Dim CurRow As Integer
Dim LastRow As Integer
Set ws = Worksheets("Sheet1")
'Set rs = Db.OpenRecordset("Z1_lab_e.dbf", dbOpenDynaset)
With rs
.AddNew
!T1F1 = ws.Cells(1, 1) ' data is in row 1, col 1
!T1F2 = ws.Cells(1, 2) ' data is in row 1, col 2
!T1F2 = ws.Cells(1, 3) ' data is in row 1, col 3
!T1F2 = ws.Cells(1, 4) ' data is in row 1, col 3
!T1F2 = ws.Cells(1, 5) ' data is in row 1, col 5
.Update
End With
'rs.Close
LastRow = ws.UsedRange.Rows.Count
' loop through the rows
For CurRow = 2 To LastRow ' data starts in row 2
With rs
.AddNew
!T2F1 = ws.Cells(CurRow, 1)
!T2F2 = ws.Cells(CurRow, 2)
.Update
End With
Next CurRow
rs.Close
db.Close
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I am tryiing another approach which seems to work better in terms of potential simplicity, however the first cell in the worksheet comes back with a value of null. Where am I going wrong with the code in trying to obtain the value of cell A1? Because the value of A1 comes back as null it does not loop and the code executes out of the loop and ends.
(I got most of the code from a helpful site on the web)
(I got most of the code from a helpful site on the web)
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
Dim db As Database, rs As Recordset, r As Long, c As String
Set db = opendatabase("C:\Panpoll\Snapshot.mdb")
' open the database
Set rs = db.OpenRecordset("Z1_lab_e", dbOpenTable)
' get all records in a table
r = 1 ' the start row in the worksheet
SetFocus = "getpayrolldata.xls"
Do While Len(Range("c" & r).Value) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("TDAY") = Range("A" & r).Value
.Fields("EmpID") = Range("B" & r).Value
.Fields("Reg_HR1") = Range("C" & r).Value
.Fields("EmpName") = Range("D" & r).Value
.Fields("OV_HR1") = Range("E" & r).Value
.Fields("Store") = Range("F" & r).Value
.
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
ASKER
In the code, the line which reads "Do While Len(Range("c" & r).Value) > 0" should actually read A instead of C. This was posted in error while I was trying a different approach to getting the value of cell A1.
ASKER
Progress. By changing the liine "Do While Len(Range("c" & r).Value) > 0" from "0" to "" it will attempt to read the first line of data, however, each line of data comes back as "empty". I tried changing the data to a numerical value but that does not make any difference. The fields contain a date, a three digit number, a name, hours worked as a number and a decimal, overtime hours in the same format and the last field contains the number 1 in this case. Any idea why I am getting an "empty" value?
As you read by coordinates (row and column), I would use Cells(r, c) and not Range.
/gustav
/gustav
ASKER
I am finally there. I am attaching the final version of the code. Thanks for all your help. i know my effort is not the most elegant result, but it works which is the main thing here.
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to table in an Access database
If (MsgBox("Do you want to update wages?", vbYesNo)) = vbYes Then
'delete here
Else
Exit Sub
End If
r = 50
Workbooks("Daily Labour Edit and Update.xlsm").Activate
If Range("A50").Value = Range("a100") Then
MsgBox "Wages for this day have already been updated. Before continuing open database and check data."
If vbOK Then
Exit Sub
Else
End If
End If
Set db = opendatabase("C:\Panpoll\Snapshot.mdb")
' open the database
Set rs = db.OpenRecordset("Z1_lab_e", dbOpenTable)
' now get all records in a table
'r = 50 ' the start row in the worksheet
Do While Len(ActiveSheet.Range("A" & r).Value) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("TDAY") = ActiveSheet.Range("A" & r).Value
.Fields("EmpID") = ActiveSheet.Range("B" & r).Value
.Fields("EmpName") = ActiveSheet.Range("C" & r).Value
.Fields("Reg_HR1") = ActiveSheet.Range("D" & r).Value
.Fields("OV_HR1") = ActiveSheet.Range("E" & r).Value
.Fields("Store") = ActiveSheet.Range("F" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
Range("a50").Copy
Range("a100").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Range("a50:e85").Select
Selection.ClearContents
Range("a1").Select
MsgBox "Daily labour data has been updated"
End Sub
If it works, that's what counts.
/gustav
/gustav