MyTetra Share
Делитесь знаниями!
Прилинковка текстовый и Excell таблиц
Время создания: 16.03.2019 23:43
Раздел: !Закладки - VBA - Access

Модуль: 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

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

Так же в этом разделе:
 
MyTetra Share v.0.53
Яндекс индекс цитирования