Select and Import Multiple Excel Spreadsheets into Access

[Havoc]

G'Day,

I have a bit of a problem.......the objective is to create a single table called 'tbl_MasterStockFile' in MS Access from importing multiple spreadsheets that are located in seperate workbooks.

(BTW...The column structure is the same in all spreadsheets with the first row being the field name).

I need help to achieve the following which is initiated from a command button called 'Import Stock/Products':

1. Delete all tables that have the a name that contains 'tbl_import'

2. Provide a File/Open dialogue allowing the user to multi select one or more Excel spreadsheets to import, very much like the single select code here:

http://www.mrexcel.com/board2/viewtopic.php?t=85521&highlight=openfile+dialog+access

2.Once the user has multi selected one or more spreadsheets then (Using the 'Transferspreadsheet' command) a table will be created per spreadsheet, with the spreadsheet first row = field names ie ('Has Field Names = Yes')

The table names need to be constructed as follows:

tbl_import_filename

filename = spreadsheet filename without .xls extension.

3. Each table (tbl_import_filename) requires the blank records removing (The Transferspreadsheet command seems to bring blank records across ?)

4. All the records in all of the (tbl_import_filename(s)) tables need to be merged and the duplicates removed. Duplicate records based on the column in the spreadsheets called 'StockID/Barcode' would be used as this field should be unique.

5. A table needs to be created called 'tbl_MasterStockFile' and the merged (tbl_import_filename(s)) without duplicate records needs to be imported into the 'tbl_MasterStockFile'.

Can anyone help ?

 

[mdmilner]

Re: Select and Import Multiple Excel Spreadsheets into Acces

You've actually got quite a bit of complex importing to do.
And, I basically have exactly what you describe already implemented.

A suggestion on technique:

If you name the column headings appropriately (fieldnames), you can import the spreadsheets directly into the destination table...and each import will automatically append to the table (not overwrite) with the DoCmd.TransferSpreadsheet method.

Deleting tables en-mass is rather simple. Here's an example of me killing error tables. This, of course, just kills tables that match a partial string of the full name.

 For Each tbl In dbs.TableDefs
     If Left(tbl.Name, 21) = "AutoExporting$_Import" Then
        DoCmd.DeleteObject acTable, tbl.Name
     End If
 Next tbl

Here is a sample function call that purges 'empty' records.

Public Function PurgeEmptyRecords(ByVal strTbl As String, ByVal x As Integer, ByVal y As Integer)
Dim dbs As DAO.Database
Dim rs As DAO.Recordset

Set dbs = CurrentDb

Set rs = dbs.OpenRecordset("Select * from " & strTbl, dbOpenDynaset)

With rs   ' Tests Two fields for Null, if both are, it purges entire record
  Do Until rs.EOF
    If IsNull(.Fields(x).Value) And IsNull(.Fields(y).Value) Then
      .Delete
    End If
    .MoveNext
  Loop
End With

Set rs = Nothing
Set dbs = Nothing
End Function

For importing, there's three approaches.
1) Create a table with the full path to each file location in a single field and iterate through that table sending the information to your code to inport (transferspreadsheet) each in turn.

2) Use the fileopen dialog to instead return the folder path (not the file path) -- and then import the entire folder (useful if you don't know the names but it's consistently an entire diretory.

3) You can set combo-boxes & listboxes to 'multiselect' - I have not tested this technique but it should be possible to select multiple items and pass them as a list to another function.

Public Function ImportExcel(ByVal tblName As String)
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim rsf As DAO.Recordset
Dim tbl As TableDef
Dim strTLoc, strFLoc, strSQL As String
Dim errNumber As Long
Dim strXLS As String

Set dbs = CurrentDb

strSQL = "SELECT * FROM " & tblName

Set rs = dbs.OpenRecordset(strSQL, dbOpenDynaset)
Set rsf = rs.OpenRecordset()

strSQL = "DELETE * FROM tblData"
DoCmd.RunSQL strSQL    ' Empties tblData prep for Import Process

With rsf
  Do Until rsf.EOF
    strFLoc = .Fields(2)
    'strFLoc = FindDefaults("DefaultOpenLocation") & Right(!f_name, 4) & "\" & !f_name & ".xls"
       If ValidateLocations(strFLoc) Then       ' Does the file location exist
         Call ImportExport("acImport", "tblData", strFLoc)
       End If
    .MoveNext
  Loop
End With

Set rsf = Nothing
Set rs = Nothing

Call PurgeEmptyRecords("tblData", 0, 1)   ' Table to test, Field1 to test, 

 ' This eliminates all the import error tables
 For Each tbl In dbs.TableDefs
     If Left(tbl.Name, 21) = "AutoExporting$_Import" Then
        DoCmd.DeleteObject acTable, tbl.Name
     End If
 Next tbl

'Set rst = Nothing
Set dbs = Nothing
End Function

Public Function ImportExport(ByVal Ltype As String, ByVal Tname As String, _
                                 ByVal TLoc As String) As Long
Dim intCnt As Integer

Select Case Ltype:
    Case "acImport":  Ltype = 0
      'DoCmd.TransferSpreadsheet acImport, 8, Tname, TLoc, True, ""
    Case "acExport":  Ltype = 1
      'DoCmd.TransferSpreadsheet acExport, 8, Tname, TLoc, True, ""
    Case "acLink":    Ltype = 2
      'DoCmd.TransferSpreadsheet acLink, 8, Tname, TLoc, True, ""
End Select
DoCmd.TransferSpreadsheet " " & Ltype, 8, Tname, TLoc, True, ""

End Function

That's most of the technique examples you'll need - although I guarantee you'll have to edit/remove/alter some of that to make it work.

Good luck

Mike

 

[Havoc]

Re: Select and Import Multiple Excel Spreadsheets into Acces

Mike.........thanks for replying I am looking into multiselect side of the file open API code at the moment:

http://www.mvps.org/access/api/api0001.htm

Can you help me out and tell me how to get the code working at the bottom of page in the following link from a AlanWarren:


http://www.experts-exchange.com/Dat...ltiselect+"multiple+files"&clearTAFilter=true

My objective is to get the filepaths and pass this info to as many transferspreadsheet commands as it takes eg.

If I select two excel files a.xls and b.xls then two tables get created with the following names :

tbl_import_a
tbl_import_b

Can you get AlanWarren's code working ?

Thanks

Paul.

 

[mdmilner]

Re: Select and Import Multiple Excel Spreadsheets into Acces

A partial answer.
The first link is actually the very code that I quoted months ago (and you quoted in your initial post on this thread)

Mine is slightly modified - cosmetic on which file types I wanted to offer filters for and a custom function (FindDefaults) that just extracts a default location to start -- that access a table. It's just using a table like an INI file.

But, nearly all that you need to get is already right there.
The multi-select link...it also references Ken Getz's code...seems to be related to extracting text file data.

And reviewing that -- all that DoCmd.TransferText stuff seems to be using Import Specifications. Import Specifications are a way to create a template for imports. Open up the import wizard (manual) - and import one of your files. Go thru to the very end, *just before* you hit Finish. Hit the advanced tab on the bottom left and SAVE the specification under a unique name.

Next time you want that file format, re-use that same specification.
Check the help for syntax or use something like:

Sub ImportRoutine(spec As String, tblA As String, dstFile As String)

  DoCmd.TransferText acImportFixed, spec, tblA, dstFile

End Sub

The multi-select appears interesting. I'll have to review it to see if there really are any changes. My first guess is that it is a small modification to the overall code.

My personal approach to this kind of thing has been to use the File Open dialog to open a folder and then to return all the files in the folder to a table...and then walk thru the table to import files. I could easily have just imported as I grabbed file names.

my Edit:
I cut the relevant segment (it's the last) in that second link of yours into an Access code module. I setup a quick call to it.

Sub dothebrowse()

apiBrowseFiles

End Sub

Works like a charm to me - no changes.
If it doesn't run for you, most likely reason is you're missing references.
Make sure the Microsoft Scripting Runting is checked (in any code module, Tools-References. Scroll to find the entries you need to check)

Code returns the file's you want - your sub (like mine above) would need to receive the files and do something with them. Aka add something like:

Dim aaa As Variant
aaa = apiBrowseFiles

Mike

 

[Havoc]

Re: Select and Import Multiple Excel Spreadsheets into Acces

Hey Mike,

I am a complete dim witt and need you to guide me as to exactly what to do to the extent of:

1. Create a new module and call it xxxx
2. Coy code and paste in module xxxx
3. Blah
4. Blah

I am sorry to bother you but I need your assitance.

Thanks

Paul

 

[Havoc]

Re: Select and Import Multiple Excel Spreadsheets into Acces

Hey Mike,

Ignore my last post........I created a new module pasted the code, created a button and called the Apibrowsefiles and that worked okay.

Like you say I need to take the result of the chosen filenames and then pass the file names and dod a loop with the transferspeadsheet command.

Using the code we have both tried could you help me out and amend as required and post here ?

Really appreciate your help.

Thanks

Paul

 

[mdmilner]

a method

Here's the simplest method.
Create a table with two fields. First field is the full path to the file you wish to import. Second is the table name you wish to use once it's imported.

Substitute the name of your table for tblName just a few lines below.

Function GetMyTables()
Dim dbs as DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String

Set dbs = CurrentDb()

strSQL = "SELECT * FROM tblName"
Set rs = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

With rs
  Do Until rs.EOF
    ImportExport("acImport", .Fields(1).Value, .Fields(0).Value)
    .MoveNext
  Loop
End With

Set rs = Nothing
Set dbs = Nothing
End Function

Public Function ImportExport(ByVal Ltype As String, ByVal Tname As String, _ 
                                 ByVal TLoc As String) As Long 
Dim intCnt As Integer 

Select Case Ltype: 
    Case "acImport":  Ltype = 0 
      'DoCmd.TransferSpreadsheet acImport, 8, Tname, TLoc, True, "" 
    Case "acExport":  Ltype = 1 
      'DoCmd.TransferSpreadsheet acExport, 8, Tname, TLoc, True, "" 
    Case "acLink":    Ltype = 2 
      'DoCmd.TransferSpreadsheet acLink, 8, Tname, TLoc, True, "" 
End Select 
DoCmd.TransferSpreadsheet " " & Ltype, 8, Tname, TLoc, True, "" 

End Function

This will not have any of the flexibility of choosing what you import.

Option #2 - uses the API. Another approach, useful if you need to save the data is to import all the file names and save them into a table. Here's a function that you can pass a start folder to that purges then populates a table called tblFiles with 2 fields. You'll have to set up the table first.

I didn't have a chance to modify one piece - I'm grabbing the name of the file. file1.xls instead of just file1 for use as a table name. You'll want to truncate that.

Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


Public Function ReturnAllFiles(Optional ByVal selDir As String) As Boolean
Dim DirName As String
Dim TempName, TempName2, TempName3 As String, FileNum As Integer
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL, strTbl As String
Dim lnCnt As Long

strTbl = "tblFiles"

Set dbs = CurrentDb
If ObjectExists("Table", strTbl) Then
  strTbl = "tblFiles"
  strSQL = "DELETE * FROM " & strTbl
  DoCmd.RunSQL strSQL
Else
  ' Create the Table
End If
'C:\DirectoryLocation
strSQL = "SELECT * FROM tblFiles"
Set rs = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    
    FileNum = FreeFile
    If selDir <> "C:\" Then
      DirName = selDir
    Else
      DirName = GetDirectory2() & "\"
      If Len(DirName) = 0 Then
        ReturnAllFiles = False
        Exit Function
      End If
    End If
    
    TempName = Dir$(DirName, vbDirectory)

    While Len(TempName)
        If (TempName <> ".") And (TempName <> "..") Then    'get rid of "." and ".."
            TempName = DirName & TempName
            lnCnt = InStr(TempName, ".xls") - 7
            TempName2 = Right(TempName, Len(TempName) - lnCnt + 1)
            'GetAttr is a built-in function
            If GetAttr(TempName) <> vbDirectory Then
                'Debug.Print TempName
                rs.AddNew
                rs.Fields(0).Value = TempName2   ' file1.xls
                rs.Fields(1).Value = TempName     ' full path to file
                rs.Update
            End If
        End If
        TempName = Dir$
    Wend
    
    Close #FileNum

ReturnAllFiles = True

Set rs = Nothing
Set dbs = Nothing
End Function

Public Function GetDirectory2(Optional Msg) As String

    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim R As Long, x As Long

'   Root folder = Desktop
    bInfo.pidlRoot = 0&

'   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    
'   Type of directory to return
    bInfo.ulFlags = &H1

'   Display the dialog
    x = SHBrowseForFolder(bInfo)
    
'   Parse the result
    path = Space$(512)
    R = SHGetPathFromIDList(ByVal x, ByVal path)
    If R Then
          x = InStr(path, Chr$(0))
        GetDirectory2 = Left(path, x - 1)
    Else
        GetDirectory2 = ""
    End If

End Function

I'm not sure how much further help I can really be. The demands on my time since the beginning of the year seem to have exploded and I just don't have the time available to write out long detailed - specific explanations. Hopefully this will be enough for you to get something working.

Mike