Import Specific Worksheet From Excel

[esneaker]

Greetings!!

I am new to MS Access and have been trying to use VBA to import a specific worksheet called "Access" in an Excel file (from about 400 users) into a single table. I want the code to search through one folder and import the "Access" worksheet in each Excel workbook within that folder. Each user has the same worksheet name. Here's my problem. I got this VBA code from: AccessMVP where KDSnell gave examples of how to import Excel worksheets into MS Access Tables (I can't post the link, sorry)

Sub ImportExcel()
Dim strPathFile As String, strFile As String, strPath As String
Dim blnHasFieldNames As Boolean
Dim intWorksheets As Integer

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
Dim strWorksheets(1 To 1) As String

' this code assumes that each worksheet
' with the same name is being imported into a separate table
' for that specific worksheet name)
Dim strTables(1 To 1) As String

' Replace generic worksheet names with the real worksheet names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strWorksheets(1) = "Access"


' Replace generic table names with the real table names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strTables(1) = "Access"


' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "J:\MyWorkbooks\"

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
For intWorksheets = 1 To 1

strFile = Dir(strPath & "*.xlsm")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, _
acSpreadsheetTypeExcel12Xml, strTables(intWorksheets), _
strPathFile, blnHasFieldNames, _
strWorksheets(intWorksheets)
strFile = Dir()
Loop

Next intWorksheets
End Sub

When I execute the code. Nothing happens. I go to the table and find nothing....or I get Runtime error 3011, where MS Access can not find the object "Access". Can someone please help me figure this out?? Also, is it possible to update the table without duplicating records?

I'm using Excel 2010 and Access 2010.

:banghead:Thank you for your time and help!

 

[arnelgp]

do you have same field name, and field count against your excel worksheet?

 

[esneaker]

Greetings!

Yes, each workbook has the same field name, same column count, and same sheet name "Access".

 

[arnelgp]

here is a long vba, run ImportExcel proc
it check the directory you point for .xlsx files
check each .xlsx file for a sheet named "Access"
if it found that sheet on a worksheet, add the record to our "Access table".
exit where there is no more .xlsx file to process.

Public Function DirPicker(Optional ByVal strWindowTitle As String = "Select a folder where .xls files are located") As String
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    fd.Title = strWindowTitle
    If fd.Show = -1 Then
        DirPicker = fd.SelectedItems(1)
    Else
        DirPicker = vbNullString
    End If
    Set fd = Nothing
End Function


Public Sub ImportExcel()

    Dim strCon As String
    Dim strPath As String
    Dim strExcel As String
    Dim strTableName As String
    Dim strFieldName As String
    
    Dim dbSource As DAO.Database
    Dim dbTarget As DAO.Database
    
    Dim rsSource As DAO.Recordset
    Dim rsTarget As DAO.Recordset
    
    Dim tblDef As DAO.TableDef
    
    Dim bolFound As Boolean
    Dim i As Integer
    Dim j As Integer
    
    strCon = "Excel 12.0 Xml; IMEX = 2; HDR = YES; ACCDB = YES"
    
    strPath = DirPicker
    
    If (strPath & "" = "") Then
        ' no folder was selected, do nothing
    Else
        
        strPath = Replace(strPath & "\", "\\", "\")
    
        strExcel = Dir(strPath & "*.xlsx")
        
        If (strExcel & "" = "") Then
            
            'no excel file found in this folder
            'do nothing
            
        Else
            ' we have found one so lets go!
            ' open our access table
            Set dbTarget = CurrentDb
            Set rsTarget = dbTarget.OpenRecordset("Access", dbOpenDynaset)
            
            While Len(strExcel) <> 0
                ' open our excel workbook. we open it like a database. Cool ha!
                Set dbSource = OpenDatabase(strPath & strExcel, False, True, strCon)
                bolFound = False
                For Each tblDef In dbSource.TableDefs
                
                    strTableName = tblDef.Name
                    
                    If strTableName = "Access$" Then
                        bolFound = True
                        Exit For
                    End If
                Next
                
                If bolFound Then
                    
                    Set rsSource = dbSource.OpenRecordset("Select * From [Access$]")
                    
                    With rsSource
                        .MoveFirst
                        While Not .EOF
                        
                            rsTarget.AddNew
                            
                            For i = 0 To .Fields.Count - 1
                                
                                ' check sheet name against table name
                                ' just to be sure
                                strFieldName = .Fields(i).Name
                                For j = 0 To rsTarget.Fields.Count - 1
                                    If rsTarget(j).Name = strFieldName Then
                                        rsTarget(strFieldName) = .Fields(i)
                                        Exit For
                                    End If
                                Next j
                            Next i
                            
                            rsTarget.Update
                            
                            .MoveNext
                        Wend
                    End With
                End If
                
                Set rsSource = Nothing
                Set dbSource = Nothing
                
                strExcel = Dir()
            
            Wend
        End If
    
    End If
    
    Set rsSource = Nothing
    Set rsTarget = Nothing
    
    Set dbSource = Nothing
    Set dbTarget = Nothing
        
End Sub

 

[esneaker]

That works perfectly! Thanks!! I appreciate your assistance!

Right now, I'm deleting the entire table and then calling the ImportExcel VBA...if there's an easier method, without having to close the table and reopening it, that would be awesome!

DoCmd.SetWarnings False

'SQL delete statement
DoCmd.RunSQL "DELETE * FROM Access"

'Import spreadsheet
Call ImportExcel

DoCmd.SetWarnings True

 

[arnelgp]

your code is just fine, but if you really want to delete the records in Access table inside our code, just add the second line of code on the first line:

Set dbTarget = CurrentDb
dbtarget.execute "Delete * from [Access];"