C
ct4accessHelp
I am working on db and I need to import data from an Excel file into a db
table (this part I've done successfully). Now, within that same Excel file
that's already open, I need to insert a column, use a formula to populate the
column with data from an absolute cell reference, then import the entire
column (along with four other columns) into an existing table in my db. I am
getting a Run-time 424 error, indicating "Object required" at the line
"Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove"
Here is the code I have so far:
Private Sub cmdRatesImport_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean
Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
blnEXCEL = False
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
xlx.Visible = False
strBrowseMsg = "Select the EXCEL file:"
strInitialDirectory = "C:\MyFolder\"
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
Filter:=strFilter, OpenFile:=False, _
DialogTitle:=strBrowseMsg, _
Flags:=ahtOFN_HIDEREADONLY)
If strPathFile = "" Then
MsgBox "No file was selected.", vbOK, "No Selection"
Exit Sub
End If
Set xlw = xlx.Workbooks.Open(strPathFile, , False)
Set xls = xlw.Worksheets("Res Codes - Burdened")
' write to workbook
xls.Columns("G:G").Select
xls.Range("G3").Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
xls.Range("G4").Select
ActiveCell.FormulaR1C1 = "=R3C6"
xls.Range("G4").Select
Selection.NumberFormat = "General"
Selection.AutoFill Destination:=xls.Range("G4:G97")
' Range("G4:G97").Select
Set xlc = xls.Range("A4")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("import_RatesTable", dbOpenDynaset, dbAppendOnly)
' write data to the recordset
Do While xlc.value <> ""
rst.AddNew
For lngColumn = 0 To rst.Fields.Count - 1
rst.Fields(lngColumn).value = xlc.Offset(0, lngColumn).value
Next lngColumn
rst.Update
Set xlc = xlc.Offset(1, 0)
Loop
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
MsgBox "Data imported"
End Sub
table (this part I've done successfully). Now, within that same Excel file
that's already open, I need to insert a column, use a formula to populate the
column with data from an absolute cell reference, then import the entire
column (along with four other columns) into an existing table in my db. I am
getting a Run-time 424 error, indicating "Object required" at the line
"Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove"
Here is the code I have so far:
Private Sub cmdRatesImport_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean
Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
blnEXCEL = False
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
xlx.Visible = False
strBrowseMsg = "Select the EXCEL file:"
strInitialDirectory = "C:\MyFolder\"
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
Filter:=strFilter, OpenFile:=False, _
DialogTitle:=strBrowseMsg, _
Flags:=ahtOFN_HIDEREADONLY)
If strPathFile = "" Then
MsgBox "No file was selected.", vbOK, "No Selection"
Exit Sub
End If
Set xlw = xlx.Workbooks.Open(strPathFile, , False)
Set xls = xlw.Worksheets("Res Codes - Burdened")
' write to workbook
xls.Columns("G:G").Select
xls.Range("G3").Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
xls.Range("G4").Select
ActiveCell.FormulaR1C1 = "=R3C6"
xls.Range("G4").Select
Selection.NumberFormat = "General"
Selection.AutoFill Destination:=xls.Range("G4:G97")
' Range("G4:G97").Select
Set xlc = xls.Range("A4")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("import_RatesTable", dbOpenDynaset, dbAppendOnly)
' write data to the recordset
Do While xlc.value <> ""
rst.AddNew
For lngColumn = 0 To rst.Fields.Count - 1
rst.Fields(lngColumn).value = xlc.Offset(0, lngColumn).value
Next lngColumn
rst.Update
Set xlc = xlc.Offset(1, 0)
Loop
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
MsgBox "Data imported"
End Sub