Consulting

Results 1 to 4 of 4

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

  1. #1
    VBAX Newbie
    Joined
    Mar 2011
    Location
    Indiana
    Posts
    3
    Location

    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 ?

    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
    Last edited by Aussiebear; 04-24-2023 at 01:36 AM. Reason: Added the code tags

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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

  3. #3
    VBAX Newbie
    Joined
    Mar 2011
    Location
    Indiana
    Posts
    3
    Location

    OBG

    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 ?

  4. #4
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •