Import selected Excel cell contents into Access

SadSadChicken

New member
Local time
Today, 00:33
Joined
Dec 27, 2007
Messages
1
:o I'm a complete newbie so please tell me if I am asking too much but I am completely stuck.
I have multiple Excel files all of which contain information in multiple worksheets but in the same cell location in each file (same worksheet name in each file) but no column headers or other information.

I need to be able to extract the contents of each Excel file into and Access database - preferably without me having to open each excel file in turn (I have over 500 of them!). So just (!) need Access to 'look' in each file and go to the same set of worksheet/cell references and bring the information into a very simple database.

Can this be done? Easily?
Thanks for your help
 
You'll want to use the transfer spreadsheet method. An example is shown below.

Be sure that all of the fields in your table match the data types of the fields in your Excel files, or you will get errors.

Also, this code requires a reference to Windows Script Host Object Model

Code:
Function Load_Data()
Dim fsCurr As Object
Dim dirCurr As Object
Dim vImport As String

vImport = "A1:L100" 'range of cells in your spreadsheet that you want to import

DoCmd.SetWarnings False

'----- Locating and establish new files to import --------
Set dirCurr = CreateObject("Scripting.FileSystemObject")
Set fsCurr = Application.FileSearch
fsCurr.NewSearch
fsCurr.LookIn = "C:\MyDirectory" 'the directory your spreadsheets are in

fsCurr.Execute 'execute file search
Select Case fsCurr.FoundFiles.Count
    Case Is > 0 'if there are file(s) to import
        '------ Begin loading  -----------
        x = fsCurr.FoundFiles.Count 'counter to count down files being imported
        DoEvents
        Do Until x = 0
            '------------ Import data -------------
            DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel9, "MyTable", fsCurr.FoundFiles.Item(x), True, vImport
            DoEvents
            x = x - 1 'reduce file count by 1
        Loop
    Case Else 'if there are no files to import
        MsgBox "No files found to import", vbExclamation, "Import"
End Select

DoCmd.SetWarnings True

End Function
 

Users who are viewing this thread

Back
Top Bottom