Модуль: w_Link

Option Compare Database

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

''создаем прилинкованную EX таблицу

''strShName -  лист для подключения

''strTblLinkName - имя файла подключения

''strTblNameCreate- имя создаваемой таблицы

'Sub testFnLinkEXCreate()

'ПутьКФайлу = "strPath.xlsx"

'    ff = w_Link.FnLinkEXCreate("11111", ПутьКФайлу, "ListPJI")

'End Sub

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

Function FnLinkEXCreate(ByVal strTblNameCreate As String, _

                            ByVal strFileName As String, _

                            ByVal strShName As String) As Boolean

    On Error GoTo FnLinkEXCreate_Err 'Назначаем переход по ошибке

    DoCmd.TransferSpreadsheet acLink, 9, strTblNameCreate, strFileName, True, strShName & "$"

FnLinkEXCreate_Exit:

    FnLinkEXCreate = True

    Exit Function

FnLinkEXCreate_Err:

    FnLinkEXCreate = False

Err.Clear 'Очищаем поток от ошибок

End Function

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

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

''создаем прилинкованную текстовую таблицу

''strPath - путь

''strTblLinkName - имя файла подключения

''strSpec - имя спецификации

''strTblNameCreate- имя создаваемой таблицы

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

Function FnLinkTextCreate(ByVal strTblLinkName As String, _

                            ByVal strSpec As String, _

                            ByVal strTblNameCreate As String)

On Error GoTo FnLinkTextCreate_Err 'Назначаем переход по ошибке

    DoCmd.TransferText acLinkDelim, strSpec, strTblNameCreate, strTblLinkName, True, ""

    Exit Function

FnLinkTextCreate_Exit:

    FnLinkTextCreate = True

    Exit Function

FnLinkTextCreate_Err:

    FnLinkTextCreate = False

Err.Clear 'Очищаем поток от ошибок

End Function

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

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

''удаление прилинкованных техстовых таблиц

''если имя(strTblLinkName) отсутствует, то сносим все

Sub testFnLinkEXCreate()

'"Excel"=Excel

'"Text;"=Text

'";DATA"=;DATABASE

strType = "Excel" '";DATA" '"Text;" '

    ff = w_Link.FnLinkTextDelete("", strType)

End Sub

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

Function FnLinkTextDelete(ByVal strTblLinkName As String, _

                            ByVal strType As String)

    On Error Resume Next

    If Len(strTblLinkName) > 0 Then

        CurrentDb.Execute ("drop table " & strTblLinkName)

    Else

        Dim oTbl As TableDef

        For Each oTbl In CurrentDb.TableDefs

            With oTbl

                If Left(oTbl.Connect, 5) = strType Then 'сравнение строки подключения с типом переданным в функцию

                    If Left(oTbl.Connect, 4) <> "List" Then 'защита от удаления прилинкованных таблиц со списками

                        DoCmd.Close acTable, oTbl.Name

                        CurrentDb.Execute ("drop table " & oTbl.Name)

                        Debug.Print .Attributes & " | " & .SourceTableName & " | " & .Name & " | " & .Connect  'm(LBound(m))

                    End If

                End If

            End With

        Next oTbl

    End If

End Function

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