Importing data from a excel sheet into access table(linked sql server table)

Excel 2010
Access 2010


i DO NOT WANT TO USE DOCMD.transferspreadsheet please.


I have a unique situation where i need to import data from an excel sheet to an access table..

Sometimes the users are using different formatting for columns.

i'm think i need to just try and take the cell(value) and not the displayed value in the cell.
and import it.

I'm trying to insert the data into a linked sql server table.

Does this code seem sufficient ?

Code:

---

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
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
' Change True to False if you do not want the workbook to be visible when the code is running
xlx.Visible = True
' Replace C:\Filename.xls with the actual path and filename of the EXCEL file from which you will read the data
Set xlw = xlx.Workbooks.Open("C:\Filename.xls", , True) ' opens in read-only mode
' Replace WorksheetName with the actual name of the worksheet in the EXCEL file
Set xls = xlw.Worksheets("WorksheetName")
' Replace A1 with the cell reference from which the first data value (no-header information) is to be read
Set xlc = xls.Range("A2") ' this is the first cell that contains data
Set dbs = CurrentDb()
' Replace QueryOrTableName with the real name of the table or query that is to receive the data from the worksheet
Set rst = dbs.OpenRecordset("QueryOrTableName", 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

---

Thanks
fordraiders

I have a question, Does it work?
Plus you should not use
On Error GoTo 0
as that can set up a difficult to get out of error loop.
You should use an Error trap to tell you what the error is and also exit the VBA code.

Many years ago I wrote this code to import data from Excel to Access and then manipulate the data, you are quite welcome to use any part of it you think would be useful.

Code:

---

Dim excelname As String, AppExcel As New Excel.Application, Wkb As Workbook, Wksh As Worksheet, ce As Object, f As Object, count2 As Integer
Dim obj As AccessObject, dbs As Object, tempTable As String, spaceIn As Integer, response As String
Dim rs As Object, recount As Integer, data As String, count As Integer, daystring As Date, Timed As Date, thisday As String, Code As String
Dim Agent As String, Name As String, rstable As Object, team As Integer, oldagent As String, tic As String
On Error GoTo Errorcatch
oldagent = ""
'DELETE TEMPORARY TABLE
Set dbs = Application.CurrentData
' Search for Temporary Table object in AllTables collection.
    tempTable = "no"
    For Each obj In dbs.AllTables
        If obj.Name = "tbl_Temp" Then
            tempTable = "yes"
        End If
    Next obj
    If tempTable = "yes" Then
        DoCmd.DeleteObject acTable, "tbl_Temp"
    End If
'Open file dialog
    Me.selFileName = dbc_OpenFile(Nz(Me.selFileName), , CurrentProject.Path)
    If IsNothing(Me.selFileName) Then Exit Sub
'assigned path and file name
    excelname = Me.selFileName
    Forms("frmImport").cmdGetSource.StatusBarText = "Opening Excel Selected Workbook."
'IMPORT EXCEL WORKSHEET
Set Wkb = AppExcel.Workbooks.Open(excelname)
Set Wksh = Wkb.Sheets(1)
    thisday = Wksh.Range("b2")
    Wksh.Range("d3").Value = 1
    Wksh.Range("d3:d600").Select
    With Wkb.Application.Selection
        .DataSeries Rowcol:=xlColumns, Type:=xlLinear, date:=xlDay, Step:=1, Trend:=False
    End With
    Forms("frmImport").cmdGetSource.StatusBarText = "Transferring Worksheet Data."
    DoCmd.TransferSpreadsheet acImport, , "tbl_Temp", Me.selFileName, True
    Wkb.Save
    Wkb.Close
    AppExcel.Quit
    Set Wkb = Nothing
    Set AppExcel = Nothing
    Forms("frmImport").cmdGetSource.StatusBarText = "Converting Data."
    count = InStr(1, thisday, ":")
    thisday = Right(thisday, Len(thisday) - (count + 1))
    count = InStr(1, thisday, ",")
    daystring = DateValue(Right(thisday, Len(thisday) - (count + 1)))
    Me.[Report Date] = daystring
    count2 = 0
Set dbs = CurrentDb()
    For Each ce In dbs.TableDefs
        If ce.Name = "tbl_Temp" Then
            For Each f In ce.Fields
                count2 = count2 + 1
                f.Name = "Field" & count2
                If count2 > 6 Then Exit For
            Next f
        End If
    Next ce
    Set dbs = Nothing
'CONVERT DATA AND APPEND TO TABLE
    Set rs = CurrentDb.OpenRecordset("tbl_Temp Query")
Set rstable = CurrentDb.OpenRecordset("tbl_IdleInformation")
    If rstable.RecordCount > 0 Then
        rstable.MoveLast
        If rstable.date = daystring Then
            response = MsgBox("This Report with this date is already on file" & vblinefeed & " Are You Sure You Want to Continue", vbYesNo + vbExclamation + vbDefaultButton2)
            If response = vbNo Then
                rs.Close
                rstable.Close
                Set rs = Nothing
                Set rstable = Nothing
                Exit Sub  ' User chose No.
            End If
            'User Chose Yes
        End If
    End If
    recount = rs.RecordCount
    rs.MoveFirst
 
    For count = 1 To recount
        If Not IsNull(rs.Fields(0)) Then
            data = rs.Fields(0)
            If Val(Left(data, 4)) > 8000 Then
                Agent = Left(data, 4)
                If oldagent = Agent Then
                    oldagent = ""
                Else
                    oldagent = Agent
                    Name = Right(data, Len(data) - 7)
            End If
        End If
            If Val(Left(data, 5)) > 100 And Val(Left(data, 5)) < 200 Then team = Val(Mid(data, 3, 3))
            If Left(data, 5) = "  001" Or Left(data, 5) = "  002" Then
                Code = rs.Fields(0)
                Timed = rs.Fields(2)
                tic = rs.Fields(1)
                With rstable
                    .AddNew
                    !date = Me.Report_Date
                    !team = team
                    ![Idle Code] = Code
                    ![Agent ID] = Val(Agent)
                    !Agent = Name
                    !Duration = Timed
                    ![Time In Code] = Val(tic)
                    .Update
                    .Bookmark = .LastModified
                End With
            End If
        End If
        If rs.EOF Then Exit For
        rs.MoveNext
    Next count
 
    rs.Close
    rstable.Close
    Set rs = Nothing
    Set rstable = Nothing
    MsgBox "Data has been Transferred and Converted"
    Forms("frmImport").cmdGetSource.StatusBarText = ""
Exit Sub
errorcatch:
MsgBox Err.Description

---

OBP:, Thanks for the reply !!..
Yes, It works, the thing that concerns me is that sometimes..in a column the fist three cell rows may contain:
$3.44 - Format Currency
$5.21 - Format Currency
$0.32 - Format Currency
$7.21 - Format Accounting
$4.32 - Format Currency

So when i import it into a sql server linked table
The field I'm importing into is a "currency" field.
In sql server the actual table type is "Money" so just double checking to see if any formatting can take place in code to make sure the "cell" value is coming in ok ?

If the columns remain the same I would set up a table in Access with the formats that are compatible with the SQL server linked table.
I would then transfer the data from the import table to the formatted table using a query, it only take one line of code to run the query.