Import Select columns from an excel sheet to Access

[KDC900]

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:D"

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


Any help will be appreciated :)
KDC900

[OBP]

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?

[KDC900]

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

[OBP]

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/showthread.php?20548-How-to-import-a-text-file-with-more-than-255-fields-into-Access.
I can provide the Excel import routine if you want to try modifying it.
Have you searched the Rorum for "Excel Imports"?

[KDC900]

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
Dim db As DAO.Database
Dim rs As DAO.Recordset

Call DoCmd.TransferSpreadsheet(acImport, _
acSpreadsheetTypeExcel9, _
"tblData", _
"H:\ProfileName\Access\ImportTest.Xls", _
False, _
"A:A")
strSQL = "ALTER TABLE [tblData] ADD COLUMN [F2] Text(255)"
Call CurrentDb.Execute(strSQL)
strSQL = Replace(strSQL, "[F2]", "[F3]")
Call CurrentDb.Execute(strSQL)
Call DoCmd.TransferSpreadsheet(acImport, _
acSpreadsheetTypeExcel9, _
"tblDataTmp", _
"H:\ProfileName\Access\ImportTest.Xls", _
False, _
"C:D")
Set db = CurrentDb
With db.TableDefs("tblData").OpenRecordset(dbOpenTable, dbDenyWrite)
Call .MoveFirst
Set rs = db.TableDefs("tblDataTmp").OpenRecordset(dbOpenTable)
Call rs.MoveFirst
Do Until .EOF
Call .Edit
!F2 = rs!F1
!F3 = rs!F2
Call .Update
Call .MoveNext
Call rs.MoveNext
Loop
Call rs.Close
Call .Close
End With
Call db.TableDefs.Delete("tblDataTmp")

[OBP]

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

[KDC900]

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

[OBP]

Yes you are correct, it is the name of a field which holds the full path to the Excel Workbook.

[KDC900]

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?

[OBP]

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.

[KDC900]

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.

[KDC900]

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.