Using ADO from Excel to Access

JezLisle · #1 (**permalink**) 06-12-07, 15:46

Basically what I am trying to do is take a range of data from a defined Range on an excel sheet and import that into a table already set up in a Access Database.

From reading some details on this I understand that an ADO Connection is the way to go. My problem now is understanding what I need to write as my VBA code to do this.

Can anyone help?

shades · #2 (**permalink**) 06-12-07, 19:06

Howdy. If you are going to work in this arena much, I strongly recommend getting the book Integrating Excel and Access by Michael Schmalz (O'Reilly Books). He covers this exact kind of need in Chapter. The book would be a great benefit, because that is only the starting point - and he provides code samples at every step.

JezLisle · #3 (**permalink**) 06-13-07, 06:41

Thanks Rich for the book name, I'll look into that.

I found a way of doing what I was wanting to do, but now have an error on this line below.

The Error: Item cannot be found in the collection corresponding to the requested name or ordinal

Line: cmd("iKPIScore").Value = .Cells(i + 1, 9).Value

Basically all I am trying to do is import a table of data from Excel to a table in Access and store the data in the approriate formats.

Attached are 2 text files with code in which pull all info into the database, well should do.

How can I fix this error?

If needs be I could zip up the file and send.

Jez

shades · #4 (**permalink**) 06-13-07, 14:08

Howdy. I wonder if it isn't because you have missed a number in the name. Here is what you have.

Code:

            cmd("iKPI1Val").Value = .Cells(i + 1, 8).Value
            cmd("iKPIScore").Value = .Cells(i + 1, 9).Value
            cmd("iKPI2Val").Value = .Cells(i + 1, 10).Value
            cmd("iKPI2Score").Value = .Cells(i + 1, 11).Value
            cmd("iKPI3Val").Value = .Cells(i + 1, 12).Value
            cmd("iKPI3Score").Value = .Cells(i + 1, 13).Value
            cmd("iKPI4Val").Value = .Cells(i + 1, 14).Value
            cmd("iKPI4Score").Value = .Cells(i + 1, 15).Value

It seems like you should add "1" to that first part (consistent with others in the pattern).

Code:

            cmd("iKPI1Val").Value = .Cells(i + 1, 8).Value
            cmd("iKPI1Score").Value = .Cells(i + 1, 9).Value
            cmd("iKPI2Val").Value = .Cells(i + 1, 10).Value
            cmd("iKPI2Score").Value = .Cells(i + 1, 11).Value
            cmd("iKPI3Val").Value = .Cells(i + 1, 12).Value
            cmd("iKPI3Score").Value = .Cells(i + 1, 13).Value
            cmd("iKPI4Val").Value = .Cells(i + 1, 14).Value
            cmd("iKPI4Score").Value = .Cells(i + 1, 15).Value

But I may be missing something here.

JezLisle · #5 (**permalink**) 06-14-07, 03:25

Shades, thanks, I have now seen that, me that cant type :-)

I have re run the code now and this time I get a different error....

Parameter ?_9 has no default value

Does this show because I want it to be Currency and that above the same line I had the spelling mistake I state that it should be adCurrency and adParameter

How can I get around this?

JezLisle · #6 (**permalink**) 06-25-07, 04:41

I have dropped the code I used above and have tried it another way.

All I am trying to do is when I click the Upload button on my user form it sends the range of data from sheet Upload to the database and inserts it into the tblPDR.

I am having so much trouble with this. Attached are 2 text files with sample code. Upload.txt is the button click and Submit.txt is the code to input data into the database.

From this code it seems to make connection with the database but doesnt insert any data to the tblPDR table.

Can anyone help?
Jez

MikeTheBike · #7 (**permalink**) 06-25-07, 09:16

Hi

I have so many question that I do not know for example, ie.

you have a function submitPDRInfo returning a Long data type (which you use) but you do not set in the function ...

you pass shtRng pInsQry and to the function but don't use them?

Other questions which may (or may not) be relevant..

does tblPDR hava a primary key(s)?
if not ignore the rest
but, if so, is it automatic?
if not, does the record added include the primary key?
If so, do you check if it is duplicated ?

I assume you are not getting any error messages !

MTB

JezLisle · #8 (**permalink**) 06-25-07, 16:37

MTB,
Thanks for getting back to me...
Do you think that this is the right way to go, if not how would you have done this?
In the function where should I have used the Long data type?
tblPDR has a PK of the PDRID (this is built from the EmpID and the Create Date) and should not be duplicated.
I dont get any error messages, I only get the msgbox I wrote to tell me that the data has been imported.

Jez

MikeTheBike · #9 (**permalink**) 06-26-07, 08:58

Hi
I do not see any obvious error is youe code.

The following code works for me. I have modified your code a little to test for existance of records with the same PK (ie PDRID). This has the advantage of only returning a max of one record at a time.

Code:

Function submitPDRInfo() As Long
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set con = New ADODB.Connection
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\Test\TestDB.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    
    ' all records in a table
    r = 2 ' the start row in the worksheet
    Do While Len(Range("A" & r).Value) > 0
    ' repeat until first empty cell in column A
        rs.Open "SELECT * FROM tblPDR WHERE PDRID =" & Range("A" & r) & " AND CreateDate = #" & Range("G" & r) & "#", con, adOpenStatic, adLockOptimistic
        With rs
            If .RecordCount Then  ' IF RECORD EXIST THEN SAY SO
               MsgBox "A record for PDRID= " & Range("A" & r) & " AND CreateDate = " & Range("G" & r) & " already exists!", vbCritical, "Submit"
            Else ' IF NO RECORD THEN ADD TO TABLE
                .AddNew ' create a new record
                .Fields("PDRID") = Range("A" & r)
                .Fields("ManagerID") = Range("B" & r)
                .Fields("Manager") = Range("C" & r)
                .Fields("PayID") = Range("D" & r)
                .Fields("EmpName") = Range("E" & r)
                .Fields("PDRDate") = Range("F" & r)
                .Fields("CreateDate") = Range("G" & r)
                .Fields("KPI1Val") = Range("H" & r)
                .Fields("KPI1Score") = Range("I" & r)
                .Fields("KPI2Val") = Range("J" & r)
                .Fields("KPI2Score") = Range("K" & r)
                .Fields("KPI3Val") = Range("L" & r)
                .Fields("KPI3Score") = Range("M" & r)
                .Fields("KPI4Val") = Range("N" & r)
                .Fields("KPI4Score") = Range("O" & r)
                .Fields("Payment") = Range("P" & r)
                .Fields("SubmittedBy") = "Me"
                .Update ' stores the new record
            End If
        End With
        rs.Close
        r = r + 1 ' next row
    Loop
    Set rs = Nothing
    con.Close
    Set con = Nothing
End Function

Quote:

In the function where should I have used the Long data type?

For the function to return non zero then somewhere within the function you need the statment submitPDRInfo=1 (or whatever integer value you fancy).

Quote:

Do you think that this is the right way to go, if not how would you have done this?

This is basically the way I transfer data to Access DBs (more or less), although I normally have to do a significant amount of data validation/range checking along the way (I don't trust anyone not to screw up my spreadsheet!).

Sorry cannot be more helpfull

MTB

shades · #10 (**permalink**) 06-26-07, 16:43

Thanks, Mike. I have been on vacation until today, and now am swamped at work trying to catch up.

JezLisle · #11 (**permalink**) 06-28-07, 05:09

Thanks MTB, I understand your problem with people screwing spreadsheets up. If they dont know what to do they press anything and everything.

On this User Form there are only 5 selections to make and they are made by drop down box so no errors can be made, apart from their wrong choices, then thats down to them.

I'll give your advice a go now and see where I get to.

Hope its not too wet where you are :-)

Thanks,
Jez

JezLisle · #12 (**permalink**) 06-28-07, 07:15

MTB,

I have tried the code again, and still the data doesnt update tblPDR.

It runs through the code and says that data has been uploaded, but on checking the table its still empty.

I am not sure where I'm going wrong

Ive attached the excel file with it all on for easier viewing

Jez

MikeTheBike · #13 (**permalink**) 06-28-07, 08:05

Hi

Unfortunately IT policy prevents downloading, but I may try at home this evening.

We do have some flooding in Belper down by the mills, but fortunately I am on higher ground. It has been absolutely horrendous in some places not too fare away, can only be grateful we don’t live there.

Have no idea what part of the world you are in, have you been affected?

MTB

JezLisle · #14 (**permalink**) 06-28-07, 08:39

That would be great Mike, Thanks.

I live on the edge of the penines near Manchester and didnt get affected. I was in Leeds on Monday when it was coming down and was hurrendous to get home as roads flooded everywhere, my office is in Doncaster and that was surrounded by water, no way in there.

Jez

MikeTheBike · #15 (**permalink**) 06-29-07, 04:10

Hi again

I've had a look at and moded the function as indicated bellow wth th hashes #####

Code:

Function submitPDRInfo() As Long
Dim con As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set con = New ADODB.Connection
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\Test\TestDB.mdb;"
        '"Data Source=D:\Work\BonusMatrix\BonusReviews.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
'###rs.Open "tblPDR", con, adOpenKeyset, adLockOptimistic, adCmdTable
    ' all records in a table
    r = 2 ' the start row in the worksheet
'#################
Dim Data As Worksheet
Set Data = Sheets("ToSend")
'####################
    Do While Len(Data.Range("A" & r).Value) > 0
        submitPDRInfo = 1 '########  ??
        ' repeat until first empty cell in column A
        rs.Open "SELECT * FROM tblPDR WHERE PDRID =" & Data.Range("A" & r), con, adOpenStatic, adLockOptimistic
        With rs
            If .RecordCount Then  ' IF RECORD EXIST THEN SAY SO
               MsgBox "A record for PDRID= " & Data.Range("A" & r) & " already exists!", vbCritical, "Submit"
            Else ' IF NO RECORD THEN ADD TO TABLE
                .AddNew ' create a new record
                .Fields("PDRID") = Data.Range("A" & r)
                .Fields("ManagerID") = Data.Range("B" & r)
                .Fields("Manager") = Data.Range("C" & r)
                .Fields("PayID") = Data.Range("D" & r)
                .Fields("EmpName") = Data.Range("E" & r)
                .Fields("PDRDate") = Data.Range("F" & r)
                .Fields("CreateDate") = Data.Range("G" & r)
                .Fields("KPI1Val") = Data.Range("H" & r)
                .Fields("KPI1Score") = Data.Range("I" & r)
                .Fields("KPI2Val") = Data.Range("J" & r)
                .Fields("KPI2Score") = Data.Range("K" & r)
                .Fields("KPI3Val") = Data.Range("L" & r)
                .Fields("KPI3Score") = Data.Range("M" & r)
                .Fields("KPI4Val") = Data.Range("N" & r)
                .Fields("KPI4Score") = Data.Range("O" & r)
                .Fields("Payment") = Data.Range("P" & r)
                .Fields("SubmittedBy") = "Me"
                .Update ' stores the new record
            End If
        End With
        rs.Close
        r = r + 1 ' next row
    Loop
    Set rs = Nothing
    con.Close
    Set con = Nothing
End Function

Basically you were refering to the active sheet ie 'ReportFrontSheet' and not the data sheet, I assumed the data to export is in the 'ToSend' sheet, therefore added these two lines.

Dim Data As Worksheet
Set Data = Sheets("ToSend")

and qualified all range referances as 'Data.Range()'

I also removed the arguments in the function definition and call.

I am not sure what you want to do with return value of the function when duplicate 'PDRID' are present (there are two duplicates) should it return 0 or 1 ?

I use Boolean function in these circumstances the just retuen True or False

Also, if you consider trapping the No Data condition (with message) you would know what is happening !?

HTH

MTB

Internet Services

Web Development

Digital Marketing

Consumer Tech