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

В примере немного измененный вариант, но суть та же. Сам собирался писать автолинковку с разных баз. В них линковка проходит по пути из запроса из таблицы 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 If

    End If

Next

End Sub

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

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