Перелинковка таблиц из разных источников

MyTetra Share

Делитесь знаниями!

Ссылка на оригинал

Время создания: 16.03.2019 23:43

Текстовые метки: access, Link

Раздел: Разные закладки - VBA - Access - Link

Запись: xintrea/mytetra_db_adgaver_new/master/base/1515392261h074j4s1th/text.html на raw.githubusercontent.com

В примере немного измененный вариант, но суть та же. Сам собирался писать автолинковку с разных баз. В них линковка проходит по пути из запроса из таблицы MSysObjects. Предлагаю сделать таблицу с путями и выбирать пути из нее по запросу и количеству подключаемых таблиц.

Visual BasicВыделить код

For Each tdf In dbs.TableDefs

Добавить Счетчик количества подключений если равно значению из таблицы - переход на следующую базу.

If Len(tdf.Connect) > 0 Then

tdf.Connect = ";DATABASE=" & sBase & "; PWD=512512"

On Error GoTo err_Relin

tdf.RefreshLink

End If

' прогресбар

intAmountConnecting = intAmountConnecting + 1

SysCmd acSysCmdInitMeter, "Відкриваю таблиці бази " & sBase & " Зроблено: " & Format(intAmountConnecting * 100 / lngX, "##0") & "% ", dbs.TableDefs.Count '& Format(m * 100 / lngX, "##0") & "% "

Call SysCmd(acSysCmdUpdateMeter, intAmountConnecting)

Next tdf

Чем смогу - помогу. Просто времени не хватает.

Если "перелинкование" БД случается не очень часто, можно выполнять с использованием подобного кода:

Visual BasicВыделить код

Sub reLinkDB()

Dim dbs As Database, tdf As TableDef, i%, j%, s$

Set dbs = CurrentDb

For Each tdf In dbs.TableDefs

s = tdf.Connect

If Len(s) > 0 Then

i = InStr(1, s, "DATABASE=") + 9

j = InStr(i, s, ".mdb") + 3

s = Mid(s, i, j)

If Len(Dir(s)) = 0 Then

s = InputBox("", "", s)

If Len(s) = 0 Then

ElseIf Not Len(Dir(s, vbDirectory)) = 0 Then

s = ";DATABASE=" + s '+ "; PWD=512512" ' если пароль действительно нужен

tdf.Connect = s

tdf.RefreshLink

End If

End Sub

но даже если потребуется оперативно "перелинковать" (с диалогом), лучше использовать вместо "взрослого" диалога на API, библиотеку ComDlg32.ocx (Microsoft Common Dialog Control), конструкция будет намного "аккуратнее".
Евгений.

Прикрепленные файлы:

Так же в этом разделе:

MyTetra Share v.0.65