Link to home
Start Free TrialLog in
Avatar of Gerw
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.
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

Open in new window

Avatar of Jim P.
Jim P.
Flag of United States of America image

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.
Avatar of Gerw
Gerw

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
Avatar of Gerw

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. ;-)
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

Open in new window

Avatar of Gerw

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?
Avatar of Gustav Brock
Try with:

Set rs = db.OpenRecordset("Z1_lab_e", dbOpenDynaset)

- and don't close rs until you are finished.

/gustav
Avatar of Gerw

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

Open in new window

You are still closing the recordset.

/gustav
Avatar of Gerw

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
Avatar of Gerw

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",dbOpenDynaset)"  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.
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

Open in new window

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
Avatar of Gerw

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.
Avatar of Gerw

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

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Gustav Brock
Gustav Brock
Flag of Denmark image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Gerw

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)
 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

Open in new window

Avatar of Gerw

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.
Avatar of Gerw

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
Avatar of Gerw

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

Open in new window

If it works, that's what counts.

/gustav