Consulting

Results 1 to 12 of 12

Thread: Import Select columns from an excel sheet to Access

  1. #1
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location

    Import Select columns from an excel sheet to Access

    Hello,

    My situation that I am in right now is that I have a table that has every employee's info in, we import this table into access to run some of our databases. well now we needed to be able to import only some of the columns instead of all to help reduce how much info can be seen if a non management employee finds the hidden table.

    I am not good enough at VBA to figure this out. Right now what I have is below, but when it runs, the info does not end up on the same line.

    DoCmd.TransferSpreadsheet acImport, , "ALL", "J:\HumanResources\HRIS\All Table\AllT.xls", True, "A"

    DoCmd.TransferSpreadsheet acImport, , "ALL", "J:\HumanResources\HRIS\All Table\AllT.xls", True, "G:I"


    Any help will be appreciated
    KDC900

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Wouldn't it be simpler to import the table as you were, but into a temporary table.
    Transfer just the fields that you want to the master table with an append query and then delete the records in the import table with a delete query ready for a new transfer?

  3. #3
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    Hey OBP,

    That makes a lot of sense to do I will give it a go.

    I do have a question, is it possible to import select fields like I was trying to do? the reason I ask is my brain will still want to attempt to complete it. Its annoying, but that's just how my brain works, it won let it go.

    I appreciate the helpful knowledge you have provided me,
    KDC900

  4. #4
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    The problem is that you are making 2 separate Imports, so they are not positionally linked when they are placed in the table.
    It is a limitation of the TransferSpreadsheet function.
    You can use VBA to import the data by opening the Workbook & sheet and transferring the data in to required fields. The VBA code is a lot more complex though.
    You can also export the Excel worksheet as a text file and open that and read in the required fields as well.
    In fact most of the import code is in the "Sticky" post at the top of the Access Forum http://www.vbaexpress.com/forum/show...ds-into-Access.
    I can provide the Excel import routine if you want to try modifying it.
    Have you searched the Rorum for "Excel Imports"?

  5. #5
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    1. Hello OBP,

      I have look around the web and I found the below code that looked promising. I have messed around with it to see if I can get it to work but so far no luck. It is trying to add fields to a table and import.

      Dim strSQL As String
    2. Dim db As DAO.Database
    3. Dim rs As DAO.Recordset
    4. Call DoCmd.TransferSpreadsheet(acImport, _
    5. acSpreadsheetTypeExcel9, _
    6. "tblData", _
    7. "H:\ProfileName\Access\ImportTest.Xls", _
    8. False, _
    9. "A:A")
    10. strSQL = "ALTER TABLE [tblData] ADD COLUMN [F2] Text(255)"
    11. Call CurrentDb.Execute(strSQL)
    12. strSQL = Replace(strSQL, "[F2]", "[F3]")
    13. Call CurrentDb.Execute(strSQL)
    14. Call DoCmd.TransferSpreadsheet(acImport, _
    15. acSpreadsheetTypeExcel9, _
    16. "tblDataTmp", _
    17. "H:\ProfileName\Access\ImportTest.Xls", _
    18. False, _
    19. "C:D")
    20. Set db = CurrentDb
    21. With db.TableDefs("tblData").OpenRecordset(dbOpenTable, dbDenyWrite)
    22. Call .MoveFirst
    23. Set rs = db.TableDefs("tblDataTmp").OpenRecordset(dbOpenTable)
    24. Call rs.MoveFirst
    25. Do Until .EOF
    26. Call .Edit
    27. !F2 = rs!F1
    28. !F3 = rs!F2
    29. Call .Update
    30. Call .MoveNext
    31. Call rs.MoveNext
    32. Loop
    33. Call rs.Close
    34. Call .Close
    35. End With
    36. Call db.TableDefs.Delete("tblDataTmp")
Reply With Quote Reply With Quote

  • #6
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    What actually happens?
    I hate lazy coding and that code has no Error Trap to tell you if something goes wrong what it was and where it happens.

    My code is similar to that code, you can try it, but it has some code you do not need for converting data, but the code is quite interesting with some useful features and is used with a form called frmImport and a command button.
    Here is the code

    Private Sub cmdGetSource_Click()
    
      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

  • #7
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    Hello OBP,

    Where it says
    Me.selFileName = dbc_OpenFile(Nz(Me.selFileName), , CurrentProject.Path)
    If IsNothing(Me.selFileName) Then Exit Sub
    what is the me.selfilename reference. if I am not mistaken "me." is referencing an object on a form

  • #8
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Yes you are correct, it is the name of a field which holds the full path to the Excel Workbook.

  • #9
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    Hello OBP,

    I am getting an error when it gets to that spot. it says "Sub or Function not defined. Am I missing a reference in my library?
    Attached Images Attached Images

  • #10
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Sorry about that it uses a couple of module functions.
    I have attached the actual old database so that you can check the References, depending on what version of Access and Excel you are using you may not be able to use the filing function and will have to just use your your original file opening code.
    I really posted the original code to give you some alternative ideas.
    Attached Files Attached Files

  • #11
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    Hi OBP,

    My apologies for the drop off with my activity. As summer goes on and as it comes to an end my work load picks up tremendously and it has been hard to set aside free time to work on the code.

  • #12
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    Hello OBP,

    I wanted to close out this case on what I ended up doing. we created a backend database that has the master excel sheet and run Quires to create, append, and delete tables that only has the data we needed for specific databases. In the specific databases we would import the custom table from the backend database.

    Thank you for your help on this case.

  • Tags for this Thread

    Posting Permissions

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