Getting Excel Data Into Access

I have to get the data in an Excel sheet into a Access database. The datastructures of the Excel sheet and the Access database are very different, so a lot of reformatting/restructuring has to be done. So I like to use VBA to import the data. I know that I can open the sheet in an Excel instance from VBA, then reading, converting and saving it in the tables. Is this the best way to do this, or is there a way to somehow load the entire sheet into Access/VBA and navigate on the data without an Excel instance开发者_如何学C open. Thanks.

Marcel

Why don't you import the Excel data into a temporary table (that matches the Excel spreadsheet) then copy it across to the proper Access table.

If it's a 1-1 record copy (but with renaming/transformations) you could probably do it using a query. Otherwise you can iterate through the inported Excel table in VBA.

Here is a recent working example of inserting records into an existing database, these fields are are all pulled from a worksheet designed as an entry form.

Option Explicit

Private Sub insert_motor_to_DB()
'This sub will insert the motor data into the database as a new record

Dim msrSheet As Worksheet

Dim mtrSizeLoc As Range
Dim dateLoc As Range
Dim mtrSNLoc As Range
Dim mtrTechLoc As Range
Dim regLoc As Range
Dim custLoc As Range
Dim rigLoc As Range
Dim jobLoc As Range
Dim rotorSNLoc As Range
Dim rotorSizeLoc As Range
Dim rotorNULoc As Range
Dim rotorMeasLoc As Range
Dim rotorCoCLoc As Range
Dim statorSNLoc As Range
Dim statorSizeLoc As Range
Dim statorNULoc As Range
Dim statorMeasLoc As Range
Dim elastomerMFGLoc As Range
Dim BHAoFLoc As Range
Dim bendAngleLoc As Range
Dim protractorLoc As Range
Dim statorConfigLoc As Range
Dim topConLoc As Range
Dim topWBLoc As Range
Dim SoSLoc As Range
Dim stabSizeLoc As Range
Dim BAtypeLoc As Range
Dim botConLoc As Range
Dim fitLoc As Range
Dim comments As String
Dim regSTR As String
Dim custSTR As String
Dim rigSTR As String
Dim jobSTR As String
Dim stabSizeSTR As String
Dim rotorMeasSTR As String

Dim conn2 As Object ' connection
Dim rs As Object 'record set
Dim strConnection As String
Dim insertSQL As String

'Set up the range locations for validation
Set msrSheet = ThisWorkbook.Worksheets("Generate MSR")

Set mtrSizeLoc = msrSheet.Range("O5")
Set dateLoc = msrSheet.Range("O7")
Set mtrSNLoc = msrSheet.Range("O6")
Set mtrTechLoc = msrSheet.Range("O8")
Set regLoc = msrSheet.Range("O9")
Set custLoc = msrSheet.Range("O10")
Set rigLoc = msrSheet.Range("O11")
Set jobLoc = msrSheet.Range("O12")
Set rotorSNLoc = msrSheet.Range("O13")
Set rotorSizeLoc = msrSheet.Range("Q14")
Set rotorNULoc = msrSheet.Range("O14")
Set rotorMeasLoc = msrSheet.Range("O15")
Set rotorCoCLoc = msrSheet.Range("O16")
Set statorSNLoc = msrSheet.Range("O18")
Set statorSizeLoc = msrSheet.Range("Q19")
Set statorNULoc = msrSheet.Range("O19")
Set statorMeasLoc = msrSheet.Range("O20")
Set elastomerMFGLoc = msrSheet.Range("O21")
Set BHAoFLoc = msrSheet.Range("O23")
Set bendAngleLoc = msrSheet.Range("O24")
Set protractorLoc = msrSheet.Range("O25")
Set statorConfigLoc = msrSheet.Range("O28")
Set topConLoc = msrSheet.Range("O29")
Set topWBLoc = msrSheet.Range("O30")
Set SoSLoc = msrSheet.Range("O33")
Set stabSizeLoc = msrSheet.Range("O34")
Set BAtypeLoc = msrSheet.Range("O35")
Set botConLoc = msrSheet.Range("O36")
Set fitLoc = msrSheet.Range("J18")


'get comments
comments = msrSheet.OLEObjects("TextBox1").Object.Text


'Check for allowable zeroes = unfilled fields
If regLoc.value = 0 Then
    regSTR = "Not Assigned"
Else ' Do nothing at this time
    regSTR = regLoc.value
End If

If custLoc.value = 0 Then
    custSTR = "Not Assigned"
Else ' Do nothing at this time
    custSTR = custLoc.value
End If

If rigLoc.value = 0 Then
    rigSTR = "Not Assigned"
Else ' Do nothing at this time
    rigSTR = rigLoc.value
End If

If jobLoc.value = 0 Then
    jobSTR = "Not Assigned"
Else ' Do nothing at this time
    jobSTR = jobLoc.value
End If


If stabSizeLoc.value = 0 Then
    stabSizeSTR = "No Stab"
Else ' Do nothing at this time
    stabSizeSTR = stabSizeLoc.value
End If

'set up db connection
Set conn2 = CreateObject("ADODB.Connection")
'provide the path
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=C:\Users\Documents\xxMotorShopProject\DB_testingMTRS.accdb"

'open the DB
On Error GoTo ErrHandler2:
conn2.Open strConnection

'Perform the insert

insertSQL = "INSERT INTO tbl_mtrTEST ([mtrSize], [mtrSN], [buildDate],  [mtrTech],[region],[customer],[rig],[jobNum], " & _
            "[rotorSN],[rotorSize],[rotorNU], [rotorMeas], [rotorCoC], [statorSN], [statorSize], [statorNU], [statorMeas]," & _
            "[elastMFG], [AoF], [bendAngle], [protractorAngle], [statorConfig], [topCon], [topWB], [SoS]," & _
            "[stabSize], [BAtype], [botCon], [fit], [comments], [teardownYN]) " & _
        " VALUES (""" & mtrSizeLoc.value & """, """ & mtrSNLoc.value & """, """ & dateLoc.value & """, """ & mtrTechLoc.value & """," & _
        "  """ & regSTR & """, """ & custSTR & """, """ & rigSTR & """, """ & jobSTR & """," & _
        "  """ & rotorSNLoc.value & """, """ & rotorSizeLoc.value & """, """ & rotorNULoc.value & """, """ & Format(rotorMeasLoc.value, "0.000") & """," & _
        "  """ & rotorCoCLoc.value & """, """ & statorSNLoc.value & """, """ & statorSizeLoc.value & """, """ & statorNULoc.value & """," & _
        "  """ & Format(statorMeasLoc.value, "0.000") & """, """ & elastomerMFGLoc.value & """, """ & BHAoFLoc.value & """, """ & Format(bendAngleLoc.value, "0.00") & """," & _
        "  """ & Format(protractorLoc.value, "0.00") & """, """ & statorConfigLoc.value & """, """ & topConLoc.value & """, """ & topWBLoc.value & """," & _
        "  """ & SoSLoc.value & """, """ & stabSizeSTR & """, """ & BAtypeLoc.value & """, """ & botConLoc.value & """, """ & fitLoc & """ ," & _
        "  """ & comments & """,""" & "No Teardown""" & " ); "

On Error GoTo ErrHandler3:
conn2.Execute insertSQL


Application.Run "clear_MSR.clear_MSR"

JumpOut2:
JumpOut3:
conn2.Close
Set conn2 = Nothing

Exit Sub

ErrHandler2:
 MsgBox "The database file can not be accessed.  Please report this behavior.", , "Database Connection Error"
 Application.Run ("ERR_DB_Open.emailERR_openDB")
 Resume JumpOut2:

ErrHandler3:
 MsgBox "The database write failed.  Please report this behavior.", , "Database Write Error"
 Application.Run ("ERR_DB_Write.emailERR_writeDB")
 Resume JumpOut3:

End Sub

The error handling modules are emails from outlook. That is another topic. The modules to clear the sheet just clears the locations.

If you are going to write VBA to insert records into Access maybe this will help you out.

By the way to call private modules from other code elsewhere in your workbook you have to do this:

Application.Run "modulename.methodname", argument1, argument2 'if there are any arguments

It is not a very long process, setting up your field names and your worksheet locations to build the query take up the most space / time.

Insert will add the record and automatically assign the row a new ID.

Cheers - WWC