'=======================================================================================

'\\Подключение(Прилинковка) листа Excel к базе данных

'---------------------------------------------------------------------------------------

Sub test_fun_Append_Ex()

Set oDb = funOpenDatabaseDAO(str_Db_Path)

str_File = "FileName.xlsx"

str_ShName = "SheetName"

str_TblName = "TblName"

fff = fun_Append_Ex(oDb:=oDb, str_File:=str_File, str_ShName:=str_ShName, str_TblName:=str_TblName)

End Sub

'---------------------------------------------------------------------------------------

Function fun_Append_Ex(ByVal oDb As DAO.Database, _

ByVal str_File As String, _

ByVal str_ShName As String, _

ByVal str_TblName As String) As Boolean

Dim oTdl As TableDef

On Error Resume Next

oDb.Execute ("drop table " & str_TblName)

Err.Clear

On Error GoTo Error_fun_Append_Ex

Set oTdl = oDb.CreateTableDef(str_TblName)

oTdl.Connect = "Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=" & str_File ';PWD=12345"

oTdl.SourceTableName = str_ShName & "$"

oDb.TableDefs.Append oTdl

'strTbl = "ListPJI"

'db.Execute ("drop table " & strTbl)

'

'Set oTdl = db.CreateTableDef(strTbl)

'oTdl.Connect = "Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=путь.xlsx" ';PWD=12345"

'oTdl.SourceTableName = strTbl & "$"

'db.TableDefs.Append oTdl

fun_Append_Ex = True

Exit_fun_Append_Ex:

On Error GoTo 0

Exit Function

Error_fun_Append_Ex:

fun_Append_Ex = False

MsgBox "Error " & Err.Number & " (" & Err.Description & ") " & vbNewLine & "in procedure fun_Append_Ex of Module Имя модуля"

Resume Exit_fun_Append_Ex

End Function

'=======================================================================================