B
Benkong2
I have about 300 excel 2002 sheets that I want to import into Access
2002. This function was written to do that and works with named ranges
but fails when it get's to run-time error 3421 Data type conversion
error. It fails on this line: !EquipID = Trim(Left
(objExcNameRange3.Value, 2))
Could someone tell me what's wrong?
Option Compare Database
Public Function ExclImprt(strSQL As String, strExcelFile As String,
strWrksheetName As String)
'Code originally written 04/07/2004 Access v. 2002
'Code to import over $2K repairs to database table tblMain
'Uses specific named ranges in Excel file to import to specific fields
in tblMain
'To use, set "OnClick" of a button to [Event Procedure] and put the
function in the code
'strSQL should be "tblMain"
'strExcelFile should be whatever excel file you want to import data from
'strWrksheetName should be whatever sheet in the excel file the data is
on (usually this
'is "Repair Order")
'Each objExcNameRange# is a different named range in the Excel File
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim objExcel As Excel.Application 'Defines new excel instance
Dim objExcWrkBook As Excel.Workbook 'Defines specific workbook
Dim objExcWrksheet As Excel.Worksheet 'Defines specific worksheet
Dim objExcNameRange1 As Excel.Range 'Defines field 1
Dim objExcNameRange2 As Excel.Range 'Defines field 2
Dim objExcNameRange3 As Excel.Range 'Defines field 3
Dim objExcNameRange4 As Excel.Range 'Defines field 4
Dim objExcNameRange5 As Excel.Range 'Defines field 5
Dim objExcNameRange6 As Excel.Range 'Defines field 6
Dim objExcNameRange7 As Excel.Range 'Defines field 7
Dim objExcNameRange8 As Excel.Range 'Defines field 8
Dim objExcNameRange9 As Excel.Range 'Defines field 9
Set db = CurrentDb() 'Sets active database
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset, dbAppendOnly) 'Sets
what table to import to
Set objExcel = New Excel.Application 'Starts Excel
Set objExcWrkBook = objExcel.Workbooks.Open(strExcelFile) 'Opens
specified Excel file
Set objExcWrksheet = objExcWrkBook.Worksheets(strWrksheetName) 'Goes to
specified worksheet in file
'The next 9 lines finds the named ranges specified
Set objExcNameRange1 = objExcWrksheet.Range("I1")
Set objExcNameRange2 = objExcWrksheet.Range("B9")
Set objExcNameRange3 = objExcWrksheet.Range("I5")
Set objExcNameRange4 = objExcWrksheet.Range("I3")
Set objExcNameRange5 = objExcWrksheet.Range("I2")
Set objExcNameRange6 = objExcWrksheet.Range("J52")
Set objExcNameRange7 = objExcWrksheet.Range("D14")
Set objExcNameRange8 = objExcWrksheet.Range("B46")
Set objExcNameRange9 = objExcWrksheet.Range("B54")
'The next 12 lines uses the data in the named ranges and copies them to
the "tblMain"
'table.
With rs
.AddNew
!Unit_Number = objExcNameRange1.Value
!SLIC = Left(objExcNameRange2.Value, 4)
!EquipID = Trim(Left(objExcNameRange3.Value, 2))
!Eqp_Mileage = objExcNameRange5.Value
!Eqp_ComponetMileage = objExcNameRange4.Value
!Repair_Cost = objExcNameRange6.Value
!Repair_Type = objExcNameRange7.Value
!SupervisorID = Left(objExcNameRange8.Value, 1)
!DivisionID = objExcNameRange9.Value
.Update
End With
MsgBox "The following information" & vbCr & _
" was imported on" & vbCr & _
Now & "..." & vbCr & vbCr & _
"Unit Number: " & objExcNameRange1.Value & vbCr & _
"SLIC: " & objExcNameRange2.Value & vbCr & _
"Car Group: " & Mid(objExcNameRange3.Value, 3, Trim(Len
(objExcNameRange3.Value) - 2)) & vbCr & _
"Supervisor: " & Mid(objExcNameRange8.Value, 3, Len
(objExcNameRange8.Value) - 2) & vbCr & _
"Repair Type: " & objExcNameRange7.Value & vbCr & _
"Repair Cost: " & Format(objExcNameRange6.Value, "Currency"),
vbOKOnly, "Import Info"
DoCmd.OpenForm "frmMain", , , "[Unit_Number]= " & Chr(34) &
objExcNameRange1.Value & Chr(34), acFormEdit
DoCmd.Close acForm, "frm_Import"
objExcWrkBook.Close False 'Closes the Excel file without saving
objExcel.Quit 'Quits the Excel Application
rs.Close 'Closes "tblMain"
Set objExcWrkBook = Nothing
Set objExcel = Nothing
Set rs = Nothing
End Function
2002. This function was written to do that and works with named ranges
but fails when it get's to run-time error 3421 Data type conversion
error. It fails on this line: !EquipID = Trim(Left
(objExcNameRange3.Value, 2))
Could someone tell me what's wrong?
Option Compare Database
Public Function ExclImprt(strSQL As String, strExcelFile As String,
strWrksheetName As String)
'Code originally written 04/07/2004 Access v. 2002
'Code to import over $2K repairs to database table tblMain
'Uses specific named ranges in Excel file to import to specific fields
in tblMain
'To use, set "OnClick" of a button to [Event Procedure] and put the
function in the code
'strSQL should be "tblMain"
'strExcelFile should be whatever excel file you want to import data from
'strWrksheetName should be whatever sheet in the excel file the data is
on (usually this
'is "Repair Order")
'Each objExcNameRange# is a different named range in the Excel File
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim objExcel As Excel.Application 'Defines new excel instance
Dim objExcWrkBook As Excel.Workbook 'Defines specific workbook
Dim objExcWrksheet As Excel.Worksheet 'Defines specific worksheet
Dim objExcNameRange1 As Excel.Range 'Defines field 1
Dim objExcNameRange2 As Excel.Range 'Defines field 2
Dim objExcNameRange3 As Excel.Range 'Defines field 3
Dim objExcNameRange4 As Excel.Range 'Defines field 4
Dim objExcNameRange5 As Excel.Range 'Defines field 5
Dim objExcNameRange6 As Excel.Range 'Defines field 6
Dim objExcNameRange7 As Excel.Range 'Defines field 7
Dim objExcNameRange8 As Excel.Range 'Defines field 8
Dim objExcNameRange9 As Excel.Range 'Defines field 9
Set db = CurrentDb() 'Sets active database
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset, dbAppendOnly) 'Sets
what table to import to
Set objExcel = New Excel.Application 'Starts Excel
Set objExcWrkBook = objExcel.Workbooks.Open(strExcelFile) 'Opens
specified Excel file
Set objExcWrksheet = objExcWrkBook.Worksheets(strWrksheetName) 'Goes to
specified worksheet in file
'The next 9 lines finds the named ranges specified
Set objExcNameRange1 = objExcWrksheet.Range("I1")
Set objExcNameRange2 = objExcWrksheet.Range("B9")
Set objExcNameRange3 = objExcWrksheet.Range("I5")
Set objExcNameRange4 = objExcWrksheet.Range("I3")
Set objExcNameRange5 = objExcWrksheet.Range("I2")
Set objExcNameRange6 = objExcWrksheet.Range("J52")
Set objExcNameRange7 = objExcWrksheet.Range("D14")
Set objExcNameRange8 = objExcWrksheet.Range("B46")
Set objExcNameRange9 = objExcWrksheet.Range("B54")
'The next 12 lines uses the data in the named ranges and copies them to
the "tblMain"
'table.
With rs
.AddNew
!Unit_Number = objExcNameRange1.Value
!SLIC = Left(objExcNameRange2.Value, 4)
!EquipID = Trim(Left(objExcNameRange3.Value, 2))
!Eqp_Mileage = objExcNameRange5.Value
!Eqp_ComponetMileage = objExcNameRange4.Value
!Repair_Cost = objExcNameRange6.Value
!Repair_Type = objExcNameRange7.Value
!SupervisorID = Left(objExcNameRange8.Value, 1)
!DivisionID = objExcNameRange9.Value
.Update
End With
MsgBox "The following information" & vbCr & _
" was imported on" & vbCr & _
Now & "..." & vbCr & vbCr & _
"Unit Number: " & objExcNameRange1.Value & vbCr & _
"SLIC: " & objExcNameRange2.Value & vbCr & _
"Car Group: " & Mid(objExcNameRange3.Value, 3, Trim(Len
(objExcNameRange3.Value) - 2)) & vbCr & _
"Supervisor: " & Mid(objExcNameRange8.Value, 3, Len
(objExcNameRange8.Value) - 2) & vbCr & _
"Repair Type: " & objExcNameRange7.Value & vbCr & _
"Repair Cost: " & Format(objExcNameRange6.Value, "Currency"),
vbOKOnly, "Import Info"
DoCmd.OpenForm "frmMain", , , "[Unit_Number]= " & Chr(34) &
objExcNameRange1.Value & Chr(34), acFormEdit
DoCmd.Close acForm, "frm_Import"
objExcWrkBook.Close False 'Closes the Excel file without saving
objExcel.Quit 'Quits the Excel Application
rs.Close 'Closes "tblMain"
Set objExcWrkBook = Nothing
Set objExcel = Nothing
Set rs = Nothing
End Function