Запрос к внешнему файлу

Public Function LinkExcelList(filePath As String, listName As String, tableName As String) As Long
' es 18.01.04
' Подлинковка листа книги Excel в режиме: READONLY - редакция данных не доступна
' Возвращает код ошибки или 0
'-------------------------------------------------------------------------
'Аргументы:
'   filePath   = Полный путь к файлу
'   listName   = Название листа
'   tableName  = Название таблицы (в текущей базе)
'-------------------------------------------------------------------------
Dim strLink As String
Dim tdf As TableDef
'Удаляем старую таблицу (если есть)
On Error Resume Next
    DoCmd.DeleteObject acTable, tableName
    Err.Clear
On Error GoTo LinkExcelListErr
'Задаем строку подключения
    strLink = "Excel 8.0;DATABASE=" & filePath
    Set tdf = CurrentDb.CreateTableDef(tableName)
    tdf.Connect = strLink
'Задаем название листа
    tdf.SourceTableName = listName & "$"
'Удаление старой (если есть)
    If DCount("*", "MSysObjects", "[Name]='" & tableName & "' AND Type=6") > 0 Then
        CurrentDb.TableDefs.Delete tableName
    End If
 
'Создание подлинкованной таблицы
    CurrentDb.TableDefs.Append tdf
    Set tdf = Nothing
    CurrentDb.TableDefs.Refresh
    DoEvents
    Exit Function
 
LinkExcelListErr:
    LinkExcelList = Err.Number
    MsgBox "Функция [LinkExcelList] привела к ошибке:" & vbCrLf & _
    Err.Description & vbCrLf & " Err#" & Err.Number, vbCritical
End Function