Export A Range Of Excel Data To A Database (Office 2007?)

P

Pallar

New member
Joined
Jan 2, 2012
Messages
2
Reaction score
0
Points
0
Hi i have worked with this code and it works perfect.
But when i changed to office 2007 it dont.

Anyone know how to rearrange the code to function in a office 2007 environment?

Thanks alot!

Code: 
Sub DB_Insert_via_ADOSQL()
'Author       : Ken Puls (www .excelguru.com
'Macro purpose: To add record to Access database using ADO and SQL
'NOTE:  Reference to Microsoft ActiveX Data Objects Libary required

    Dim cnt As New ADODB.Connection, _
            rst As New ADODB.Recordset, _
            dbPath As String, _
            tblName As String, _
            rngColHeads As Range, _
            rngTblRcds As Range, _
            colHead As String, _
            rcdDetail As String, _
            ch As Integer, _
            cl As Integer, _
            notNull As Boolean, _
            sConnect As String

    'Set the string to the path of your database as defined on the worksheet
    dbPath = ActiveSheet.Range("B1").Value
    tblName = ActiveSheet.Range("B2").Value
    Set rngColHeads = ActiveSheet.Range("tblHeadings")
    Set rngTblRcds = ActiveSheet.Range("tblRecords")

    'Set the database connection string here
    'Private sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & dbPath & "';"     'For use with *.accdb files
    sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";"     'For use with *.mdb files

    'Concatenate a string with the names of the column headings
    colHead = " ("
    For ch = 1 To rngColHeads.Count
        colHead = colHead & rngColHeads.Columns(ch).Value
        Select Case ch
            Case Is = rngColHeads.Count
                colHead = colHead & ")"
            Case Else
                colHead = colHead & ","
        End Select
    Next ch

    'Open connection to the database
    cnt.Open sConnect
    'Begin transaction processing
    On Error GoTo EndUpdate
    cnt.BeginTrans

    'Insert records into database from worksheet table
    For cl = 1 To rngTblRcds.Rows.Count
        'Assume record is completely Null, and open record string for concatenation
        notNull = False
        rcdDetail = "('"

        'Evaluate field in the record
        For ch = 1 To rngColHeads.Count
            Select Case rngTblRcds.Rows(cl).Columns(ch).Value

                    'if empty, append value of null to string
                Case Is = Empty
                    Select Case ch
                        Case Is = rngColHeads.Count
                            rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL)"
                        Case Else
                            rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL,'"
                    End Select

                    'if not empty, set notNull to true, and append value to string
                Case Else
                    notNull = True
                    Select Case ch
                        Case Is = rngColHeads.Count
                            rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "')"
                        Case Else
                            rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "','"
                    End Select
            End Select
        Next ch

        'If record consists of only Null values, do not insert it to table, otherwise
        'insert the record
        Select Case notNull
            Case Is = True
                rst.Open "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail, cnt
            Case Is = False
                'do not insert record
        End Select
    Next cl

EndUpdate:
    'Check if error was encounted
    If Err.Number <> 0 Then
        'Error encountered.  Rollback transaction and inform user
        On Error Resume Next
        cnt.RollbackTrans
        MsgBox "There was an error.  Update was not succesful!", vbCritical, "Error!"
    Else
        On Error Resume Next
        cnt.CommitTrans
    End If

    'Close the ADO objects
    cnt.Close
    Set rst = Nothing
    Set cnt = Nothing
    On Error GoTo 0
End Sub
 
It seems to look ok, maybe you're missing the correct reference to a library object in that environment as it isn't carried over with the workbook, it has to be set at the machine. Have you tried stepping through the code using F8? if you get an error tell us what the error is and what line it faults at.
 
Ok so this is what ive done.

Which reference should i choose?
Have these ones selected atm.
  • Microsoft DAO 3.6 Object library
  • Microsoft ActiveX Data Objects 2.1 library
When stepping through the code (i removed the on error GoTo command)
i recieve this error: fault nr (swedish translation?) '-2147217900 (80040e14)'.:
Syntax error in INSERT INTO-term (swedish translation of term?)

Code: 
rst.Open "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail, cnt

Thanks in advance!


This is the total code when using office 2007

Code: 
Sub DB_Insert_via_ADOSQL()
'Author       : Ken Puls (www . excelguru . ca)
'Macro purpose: To add record to Access database using ADO and SQL
'NOTE:  Reference to Microsoft ActiveX Data Objects Libary required
    Dim cnt As New ADODB.Connection, _
            rst As New ADODB.Recordset, _
            dbPath As String, _
            tblName As String, _
            rngColHeads As Range, _
            rngTblRcds As Range, _
            colHead As String, _
            rcdDetail As String, _
            ch As Integer, _
            cl As Integer, _
            notNull As Boolean, _
            sConnect As String
    'Set the string to the path of your database as defined on the worksheet
    dbPath = ActiveSheet.Range("B1").Value
    tblName = ActiveSheet.Range("B2").Value
    Set rngColHeads = ActiveSheet.Range("Head")
    Set rngTblRcds = ActiveSheet.Range("Tbl")
    'Set the database connection string here
    sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & ";"     'For use with *.accdb files
    
    'Concatenate a string with the names of the column headings
    colHead = " ("
    For ch = 1 To rngColHeads.Count
        colHead = colHead & rngColHeads.Columns(ch).Value
        Select Case ch
            Case Is = rngColHeads.Count
                colHead = colHead & ")"
            Case Else
                colHead = colHead & ","
        End Select
    Next ch
    'Open connection to the database
    cnt.Open sConnect
    'Begin transaction processing
    On Error GoTo EndUpdate
    cnt.BeginTrans
    'Insert records into database from worksheet table
    For cl = 1 To rngTblRcds.Rows.Count
        'Assume record is completely Null, and open record string for concatenation
        notNull = False
        rcdDetail = "('"
        'Evaluate field in the record
        For ch = 1 To rngColHeads.Count
            Select Case rngTblRcds.Rows(cl).Columns(ch).Value
                    'if empty, append value of null to string
                Case Is = Empty
                    Select Case ch
                        Case Is = rngColHeads.Count
                            rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL)"
                        Case Else
                            rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL,'"
                    End Select
                    'if not empty, set notNull to true, and append value to string
                Case Else
                    notNull = True
                    Select Case ch
                        Case Is = rngColHeads.Count
                            rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "')"
                        Case Else
                            rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "','"
                    End Select
            End Select
        Next ch
        'If record consists of only Null values, do not insert it to table, otherwise
        'insert the record
        Select Case notNull
            Case Is = True
                rst.Open "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail, cnt
            Case Is = False
                'do not insert record
        End Select
    Next cl
EndUpdate:
    'Check if error was encounted
    If Err.Number <> 0 Then
        'Error encountered.  Rollback transaction and inform user
        On Error Resume Next
        cnt.RollbackTrans
        MsgBox "There was an error.  Update was not succesful!", vbCritical, "Error!"
    Else
        On Error Resume Next
        cnt.CommitTrans
    End If
    'Close the ADO objects
    cnt.Close
    Set rst = Nothing
    Set cnt = Nothing
    On Error GoTo 0
End Sub
 
Hi there,

You shouldn't need the DAO reference, but the other should be fine.

What kind of database are you trying to connect to, and are you sure that the SQL statement is actually generating good SQL? To find out, right before the following line:
Code: 
rst.Open "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail, cnt

Put in the following line:
Code: 
debug.print "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail

That will print the sql statement to the immediate window. You'll need to check that that code is actually generating something that looks right. I do wonder with your comment about Swedish translation if the INSERT INTO needs to change to the Swedish SQL equivalent?
 
You must log in or register to reply here.
Back
Top