Automate Export of Data to an Access Table

[KniteMare]

I put together a little table for one of my LAN based facilities to track their Overtime Savings as compared to each of their individual units. It works great.

What I would like to do is to export the data on a weekly basis to Access. I set up an access table to recieve the data and I can get it all to work just fine except I want the users to just click on a menu item and have the export take place in the background.

I know how to create on the fly menus and get them to accecpt commands from Excel Macros so that is not an issue.

I know how to share data in Excel from Workbook to workbook, closed or open. I'm sure it can be done Excel to Access I just can not for the life of me find anything to jumpstart me in the right direction in either application's help files. Anybody out there linking their Excel data to Access?

Yours in EXCELent Frustration
KniteMare

 

[Centrican]

Ok... moving forward with this problem! I've got it to successfully update things to access table, but it's updating the first column, and then the second column not in line with the first. Do you have to add each row in turn, or do you add each field? That seemed to be what the initial code was telling me to do...

The code I'm using so far is as follows, I know its a bit long and messy but it's the easiest way to control exactly what I'm doing:

Sub exportToAccessADO()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim cl As Range
Dim tablename As String
Dim InputRange As Range
Dim dbfullname As String
Dim FieldName As String

    dbfullname = "\\na-13\bgremicrosoftaccesslevel2\NationalMetering\ProActive_Compensation\aamanchesterreturns.mdb"
    tablename = "[Issued Data1]"
    
loops = 1

Run:
If loops = 1 Then FN = "Week Ending"
If loops = 2 Then FN = "Company"
If loops = 3 Then FN = "srv_ID"
If loops = 4 Then FN = "GAR"
If loops = 5 Then FN = "Area"
If loops = 6 Then FN = "reasoncode"
If loops = 7 Then FN = "dateraised"
If loops = 8 Then FN = "received date time"
If loops = 9 Then FN = "appointmentdate"
If loops = 10 Then FN = "timeslot"
If loops = 11 Then FN = "readingdate"
If loops = 12 Then FN = "reason"
If loops = 13 Then FN = "default"
If loops = 14 Then FN = "filename"
If loops = 15 Then FN = "appkept"
If loops = 16 Then FN = "Cancelled?"
If loops = 17 Then FN = "Incompatible?"
If loops = 18 Then FN = "InsuffAddress?"
If loops = 19 Then FN = "Emergency?"
If loops = 20 Then FN = "Emergency Kept"
If loops = 21 Then FN = "File Sent Late?"
If loops = 22 Then FN = "File Fail?"
If loops = 23 Then FN = "Dupflag"
If loops = 24 Then FN = "Res"
If loops = 25 Then FN = "Accessindicator"
If loops = 26 Then FN = "visitattempted"

    FieldName = FN

Sheets("data").Select
Selection.Activate

    Set InputRange = Worksheets("Data").Range("a2:a200")
    

MsgBox (FN)
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & dbfullname & ";"
    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenKeyset
    rs.LockType = adLockOptimistic
    rs.Open tablename, cn, , , adCmdTable
    For Each cl In InputRange
        With rs
            .AddNew
            .Fields([FieldName]) = cl.Value
            .Update
        End With
    Next cl
    Set rs = Nothing
    Set cl = Nothing
    cn.Close
    Set cn = Nothing

loops = loops + 1
If loops = 2 Then Set InputRange = Worksheets("Data").Range("b:b")
If loops = 3 Then Set InputRange = Worksheets("Data").Range("c:c")
If loops = 4 Then Set InputRange = Worksheets("Data").Range("d:d")
If loops = 5 Then Set InputRange = Worksheets("Data").Range("e:e")
If loops = 6 Then Set InputRange = Worksheets("Data").Range("f:f")
If loops = 7 Then Set InputRange = Worksheets("Data").Range("g:g")
If loops = 8 Then Set InputRange = Worksheets("Data").Range("h:h")
If loops = 9 Then Set InputRange = Worksheets("Data").Range("i:i")
If loops = 10 Then Set InputRange = Worksheets("Data").Range("j:j")
If loops = 11 Then Set InputRange = Worksheets("Data").Range("k:k")
If loops = 12 Then Set InputRange = Worksheets("Data").Range("l:l")
If loops = 13 Then Set InputRange = Worksheets("Data").Range("m:m")
If loops = 14 Then Set InputRange = Worksheets("Data").Range("n:n")
If loops = 15 Then Set InputRange = Worksheets("Data").Range("o:o")
If loops = 16 Then Set InputRange = Worksheets("Data").Range("p:p")
If loops = 17 Then Set InputRange = Worksheets("Data").Range("q:q")
If loops = 18 Then Set InputRange = Worksheets("Data").Range("r:r")
If loops = 19 Then Set InputRange = Worksheets("Data").Range("s:s")
If loops = 20 Then Set InputRange = Worksheets("Data").Range("t:t")
If loops = 21 Then Set InputRange = Worksheets("Data").Range("u:u")
If loops = 22 Then Set InputRange = Worksheets("Data").Range("v:v")
If loops = 23 Then Set InputRange = Worksheets("Data").Range("w:w")
If loops = 24 Then Set InputRange = Worksheets("Data").Range("x:x")
If loops = 25 Then Set InputRange = Worksheets("Data").Range("ba:bb")
If loops = 26 Then Set InputRange = Worksheets("Data").Range("bb:bb")
If loops = 27 Then GoTo theend
GoTo Run

theend:
    
End Sub

Thanks for your help so far, really helping me to understand all this. I still can't believe there's no way to simulate the "paste append" feature of access!

 

[tusharm]

(A) You are unconditionally setting InputRange to column A (just before the MsgBox FN statement). So, no matter the effect of the lower part of the loops=... tests, you always have inputrange as column A.

(B) You can combine the entire lower list of IF tests and the initial a2:a200 with set inputrange = range(cells(1,loops),cells(200,loops)) -- that's assuming you want to work with only the 1st 200 rows -- and assuming there are no breaks in your column list.

(C) What kind of data table do you have? Your code as written currently adds a new row (record) in the table so that it contains just one field. So, you will have 200 records with field1 specified, then 200 more with just field2 in it, etc. At the end you will have 200*26 records each with 1 field specified. Is that the intent?
Or do you want to create 1 record with all fields field1 to field28 specified? In this scenario you will have 200 records added each with all fields included.

 

[NateO]

Hello,

What might be nice is if you had a contiguous Range of data that lined up with your Access table. Then it would just be a matter of passing the Range's Values to an Array, and iterating on the 2d Array to pass the values to your Recordset.

For example, I have a Table with 28 fields, and I can push A1:AB200 to that Recordset/Table fairly quickly, and painlessly with the following:

Sub foo()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim varArr() As Variant, i As Long, j As Long
Let varArr() = Worksheets(1).Range("A1:AB200").Value
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp\db1.mdb"
Set rs = New ADODB.Recordset
With rs
    .Open "Select * From TableFoo", cn, adOpenForwardOnly, adLockPessimistic
    For i = LBound(varArr, 1) To UBound(varArr, 1)
        .AddNew
        For j = LBound(varArr, 2) To UBound(varArr, 2)
            Let .Fields(j - 1).Value = varArr(i, j)
        Next
    Next
    .Update
    .Close:                     Set rs = Nothing
End With
cn.Close:                       Set cn = Nothing
End Sub

Note that I'm referring to the Field not by name, but its Item Number in the Collection of Fields. One thing to be aware of is that the Excel-generated Array is 1-based, and the Fields Collection is 0-based, as are most Collections in Excel and Access, respectively; hence, j-1. This code pretty-much simulates a direct Copy->Paste Append, into Access.

Is your Excel set-up not this clean? Is it possible to get it so that it is? It might make your life a little easier if it is.

Either way, use a structured loop and get rid of those Gotos, more than one Goto in a Routine is somewhat dubious, and not necessary in this case.

 

[Centrican]

My data is in the format yours is. And I want to have x number of new records each with 26 fields. I've been trying to update each field individually because the initial code made it seem like I had to update to a named field.

If that's not the case I think a simple copying of the code you just posted will do all that my whole code does. I used to copy / paste append, so if that basically automates it it will be great. Implementing now, fingers crossed.

 

[Centrican]

Unfortunatly, I'm just getting "Item could not be found in the collection corresponding the selected name or ordinal"

I was getting a type mismatch till I changed the database to be all text fields so I think it's finding it correctly at least...

 

[NateO]

Hello,

Are you trying to export more columns than you have fields?

How many Fields are in your Table (this is an existing Table, right?)?

Msgbox rs.Fields.Count

How many columns are you trying to export?

MsgBox UBound(varArr, 2)

To answer your earlier question:

Do you have to add each row in turn, or do you add each field?

Your Fields on an existing Table should exist, don't they? You're just Adding a new Record for each row data to your existing table.

Or I have misunderstood the question... Is this a new table or existing table?

 

[tusharm]

Don't just blindly copy Nate's code and expect it to work.

Take his *structure* and adapt it to your own data layout. You have items in a:x and then ba:bb. Nate's code works with a:ab

Unfortunatly, I'm just getting "Item could not be found in the collection corresponding the selected name or ordinal"

I was getting a type mismatch till I changed the database to be all text fields so I think it's finding it correctly at least...

 

[guyborchers]

I was wondering if there was an updated link to the information that used to be found at the website Nate posted....

NateO
MrExcel MVP


Joined: 18 Feb 2002
Posts: 8313
Location: Minneapolis, Mn, USA
canada.gif

PostPosted: Tue Jun 25, 2002 1:54 pm Post subject: Reply with quote Report Post
You may want to check some of Ole's thoughts on the subject:

http://edc.bizhosting.com/english/adodao.htm

Rumor has it that ADO whups up on DAO.

 

[NateO]

Yes, see the following:

http://www.erlandsendata.no/english/index.php?t=envbadac

But, pending what you're doing, I think I'd use an array...

I should clarify that comment on DAO vs. ADO that you've quoted...

Often times DAO is more efficient w/ Access, as it was specifically designed and optimized specifically for Jet. However, Microsoft moved away from DAO and towards ADO with the release of Access 2000 to increase the consistency of working with Jet and other DB platforms.

 

[guyborchers]

Oh,

Then the above link may not be what I am seeking.

I am hoping to find much information to digest about exporting Excel fields to a MSSQL database.

is this something that ADO can accomplish?