tomlancaster
New Member
- Joined
- Apr 7, 2009
- Messages
- 26
Hi there, I am using the attached code to export to a database from an excel worksheet but its returning a runtime error '6' Overflow.
The debug highlights the below line but I don't understand what's causing it? Please could somebody help?
DEBUG:
ACTUAL CODE:
The debug highlights the below line but I don't understand what's causing it? Please could somebody help?
DEBUG:
Code:
.Fields(lngCol) = rngData.Cells(lngRow, lngCol + CLng(1)).Value
ACTUAL CODE:
Code:
'Following is a very simple piece of code to Export an Excel range to Access.
'Run the procedure ExportToAccess. Copy the complete code given below:
Option Explicit
'Goto Menu - Tools->References and add reference to Microsoft ActiveX Data Objects 2.x Library
Dim objConnection As ADODB.Connection
Sub ConnectToDatabase(strDBpath As String)
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & strDBpath
End Sub
Sub ExportToAccess(rngData As Range, Optional blnHeader As Boolean = False)
Dim rstTable As ADODB.Recordset
Dim lngRow As Long
Dim lngCol As Long
Dim strDB As String
Dim strTable As String
Dim intStartRow As Integer
If blnHeader = False Then
intStartRow = 1
Else
intStartRow = 2
End If
'---------------------User Inputs-------------------------------
'Provide database path
strDB = "[URL="file://\\hbeu.adroot.hsbc\GB002\CSS"]C:\t[/URL]emp\CS_Quality_DB.mdb"
'Provide SQL Query or Table name from database
strTable = "[Customer Perception]"
'===============================================================
'Establish Database connection
'On Error GoTo ErrH
Call ConnectToDatabase(strDB)
Set rstTable = New ADODB.Recordset
rstTable.Open strTable, objConnection, adOpenKeyset, adLockOptimistic, adCmdTable
'Check if No of data columns are same as No. of fields in database
If rngData.Columns.Count <> rstTable.Fields.Count Then
MsgBox "No. of columns in data is different from no. of fields in DB table", vbCritical, "Export Error"
GoTo ExitH
End If
For lngRow = intStartRow To rngData.Rows.Count
With rstTable
.AddNew
For lngCol = 0 To (.Fields.Count - 1)
.Fields(lngCol) = rngData.Cells(lngRow, lngCol + CLng(1)).Value
Next lngCol
.Update
End With
Next lngRow
On Error GoTo 0
GoTo ExitH
ErrH:
If objConnection.State = 1 Then rstTable.CancelUpdate
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Export Error"
ExitH:
If objConnection.State = 1 Then rstTable.Close
Set rstTable = Nothing
End Sub
Sub CloseDB()
objConnection.Close
Set objConnection = Nothing
End Sub