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

[fordraiders]

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 ?


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

[OBP]

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.


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

[fordraiders]

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 ?

[OBP]

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.