Импорт таблиц

Option Compare Database
 
Function ImportExcelFile()
 
Dim MyPatch As String
 
'Dim Connection As New ADODB.Connection
'Dim Catalog As New ADOX.Catalog
'Dim RecordSet As New ADODB.RecordSet
'Dim Field As Field
'
'Const DatabasePath = 'адрес базы'
'
'Connection.Open = 'Provider=Microsoft.Jet.OLEDB.4.0;' + _
'    'Data source = ' + DatabasePath
'
'Set Catalog.ActiveConnection = Connection
'RecordSet.Open 'название базы', Catalog.ActiveConnection, adOpenDynamic, adLockOptimistic
'RecordSet.Fields.Refresh
 
 
MyPatch = 'адрес файла'
 
On Error Resume Next
DoCmd.DeleteObject acTable, 'название файла'
Err = 0 
 
DoCmd.TransferSpreadsheet acImport, 8, 'название файла', MyPatch, True, ''
End Function

If Mid(FILENAME, (Len(FILENAME) - 3), 4) = '.xls' Then
  FILENAME = Mid(FILENAME, 1, Len(FILENAME) - 4)
End If

Sub ImportAll()
 
Dim name As String
Dim MyPatch As String
 
name = Dir('O:files ')
Do Until name = ''
    Debug.Print name
 
MyPatch = 'O:files ' & name & ''
 
var = Split(name, '.')
name = var(0)
 
On Error Resume Next
DoCmd.DeleteObject acTable, name
Err = 0
 
DoCmd.TransferSpreadsheet acImport, 8, name, MyPatch, True, ''
 
name = Dir
 
Loop
 
End Sub