"Anne" <av*@telmore.ru> wrote in message
news:3f***********************@dread16.news.tele.d k...
Hi NG
I got a folder in which I got 1000 excelfiles. In each file there is one
or more worksheets. I need to import theese sheets in access. I want to use
docmd.transferspreadsheet, but my problem is that I don't know the name of
the worksheet, and I don't know the number of worksheets in each file.
Is there anyone who can help?
Thx in advance
Henry
You don't say whether you've started to write the import routine and have
gotten stuck or whether you don't know where to start. One possible route -
create a new form with a button "cmdImport" and copy the following code in -
changing the two constants at the top.
Fletcher
Notes:
The code uses late binding to avoid reference issues - although you could
switch to early
I would be very cautious of DoCmd.TransferSpreadsheet - although it will be
relatively fast, it does not allow for custom error handling. If you really
wanted to go this way, then make sure you first import to a dummy table with
very loose requirements - perhaps all text 255 characters long with no
indexes and no required fields. Once you have this temp table, you can then
make sure all the required fields are there and are in the right format.
Option Compare Database
Option Explicit
Const XLFOLDER = "C:\Test\Workbooks\"
'
Const XLTARGET = "Table1"
'
'
'
Private Function ImportSheets(xlApp As Object, strPath As String) As Boolean
On Error GoTo Err_Handler
Dim xlBook As Object ' Excel.Workbook
Dim xlSheet As Object ' Excel.Worksheet
Set xlBook = xlApp.Workbooks.Open(strPath, False, True)
For Each xlSheet In xlBook.Worksheets
DoCmd.TransferSpreadsheet acImport, _
acSpreadsheetTypeExcel5, _
XLTARGET, _
strPath, _
False, _
xlSheet.Name & "$"
Next
ImportSheets = True
Exit_Handler:
On Error Resume Next
If Not xlBook Is Nothing Then
xlBook.Close
Set xlBook = Nothing
End If
Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Function
Private Sub cmdImport_Click()
On Error GoTo Err_Handler
Dim xlApp As Object ' Excel.Application
Dim fso As Object ' FileSystemObject
Dim fld As Object ' Folder
Dim fil As Object ' File
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(XLFOLDER) Then
Set xlApp = CreateObject("Excel.Application")
Set fld = fso.GetFolder(XLFOLDER)
For Each fil In fld.Files
If UCase(fso.GetExtensionName(fil.Path)) = "XLS" Then
If Not ImportSheets(xlApp, fil.Path) Then
MsgBox "Error importing '" & fil.Path & "'", _
vbExclamation, "Import Error"
End If
End If
Next fil
End If
MsgBox "Done", vbInformation, "Import Routine"
Exit_Handler:
If Not fld Is Nothing Then
Set fld = Nothing
End If
If Not fld Is Nothing Then
Set fld = Nothing
End If
If Not xlApp Is Nothing Then
xlApp.Quit
Set xlApp = Nothing
End If
If Not fso Is Nothing Then
Set fso = Nothing
End If
Exit Sub
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Sub
