Сохранение связанных таблиц для Доступа DBS в той же папке, когда папка изменяется

Это язык, который говорит вам, что ваш дизайн неверен. И это. Наследование отражает отношения «есть». Не «имеет-а».

Решение состоит в том, чтобы использовать композицию вместо наследования. Я бы привел пример, но совершенно неясно, что вы на самом деле намереваетесь выполнить, и не можете придумать ни одного разумного примера.

8
задан HansUp 11 February 2015 в 04:47
поделиться

2 ответа

Обновление 14APR2009 я нашел, что предыдущий ответ, который я дал здесь, был ошибочен, таким образом, я обновил его с новым кодом.

Как продолжить двигаться

  • Скопируйте код ниже в модуль VBA.
  • Из кода или из окна Immediate в IDE VBA, просто введите:

    RefreshLinksToPath Application.CurrentProject.Path
    

Это теперь повторно свяжет все связанные таблицы для использования каталога, где приложение расположено.
Это только должно быть сделано однажды или каждый раз, когда Вы повторно связываете или добавляете новые таблицы.
Я рекомендую делать это из кода каждый раз, когда Вы запускаете свое приложение.
Можно затем переместить базы данных без проблем.

Код

'------------------------------------------------------------'
' Reconnect all linked tables using the given path.          '
' This only needs to be done once after the physical backend '
' has been moved to another location to correctly link to    '
' the moved tables again.                                    '
' If the OnlyForTablesMatching parameter is given, then      '
' each table name is tested against the LIKE operator for a  '
' possible match to this parameter.                          '
' Only matching tables would be changed.                     '
' For instance:                                              '
' RefreshLinksToPath(CurrentProject.Path, "local*")          '
' Would force all tables whose ane starts with 'local' to be '
' relinked to the current application directory.             '
'------------------------------------------------------------'
Public Function RefreshLinksToPath(strNewPath As String, _
    Optional OnlyForTablesMatching As String = "*") As Boolean

    Dim collTbls As New Collection
    Dim i As Integer
    Dim strDBPath As String
    Dim strTbl As String
    Dim strMsg As String
    Dim strDBName As String
    Dim strcon As String
    Dim dbCurr As DAO.Database
    Dim dbLink As DAO.Database
    Dim tdf As TableDef

    Set dbCurr = CurrentDb

    On Local Error GoTo fRefreshLinks_Err

    'First get all linked tables in a collection'
    dbCurr.TableDefs.Refresh
    For Each tdf In dbCurr.TableDefs
        With tdf
            If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = TableDefAttributeEnum.dbAttachedTable) _
               And (.Name Like OnlyForTablesMatching) Then
                collTbls.Add Item:=.Name & .Connect, key:=.Name
            End If
        End With
    Next
    Set tdf = Nothing

    ' Now link all of them'
    For i = collTbls.count To 1 Step -1
        strcon = collTbls(i)
        ' Get the original name of the linked table '
        strDBPath = Right(strcon, Len(strcon) - (InStr(1, strcon, "DATABASE=") + 8))
        ' Get table name from connection string '
        strTbl = Left$(strcon, InStr(1, strcon, ";") - 1)
        ' Get the name of the linked database '
        strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\"))

        ' Reconstruct the full database path with the given path '
        strDBPath = strNewPath & "\" & strDBName

        ' Reconnect '
        Set tdf = dbCurr.TableDefs(strTbl)
        With tdf
            .Connect = ";Database=" & strDBPath
            .RefreshLink
            collTbls.Remove (.Name)
        End With
    Next
    RefreshLinksToPath = True

fRefreshLinks_End:
    Set collTbls = Nothing
    Set tdf = Nothing
    Set dbLink = Nothing
    Set dbCurr = Nothing
    Exit Function

fRefreshLinks_Err:
    RefreshLinksToPath = False
    Select Case Err
        Case 3059:

        Case Else:
            strMsg = "Error Information..." & vbCrLf & vbCrLf
            strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
            strMsg = strMsg & "Description: " & Err.Description & vbCrLf
            strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            MsgBox strMsg
            Resume fRefreshLinks_End
    End Select
End Function

Этот код адаптирован из этого источника: http://www.mvps.org/access/tables/tbl0009.htm.
Я удалил всю зависимость от других функций для создания этого автономным, вот почему это немного длиннее, чем это должно.

10
ответ дан 5 December 2019 в 17:42
поделиться

Вы обращаетесь к обновлению ссылок в Вашей форме Word или ссылок связанной таблицы между Вашими базами данных Access?

Для первого лучший способ, которым я знаю, состоит в том, чтобы сохранить Вашу строку (строки) подключения на уровне Модуля в рамках Вашего Word document/VBA проект и сделать их строками константы. Затем при установке строки подключения для объектов Соединения ADO, передайте его относительная константа строки подключения.

Для последнего я испытал бы желание использовать относительный путь в строке подключения к данным в каждой базе данных Access к другому. Например,

Dim connectionString as String

connectionString = ";DATABASE=" & CurrentProject.Path & "\[Database Name Here].mdb"

если, как Вы говорите, базы данных копируются вместе в другую папку (я принимаю в ту же папку).

0
ответ дан 5 December 2019 в 17:42
поделиться
Другие вопросы по тегам:

Похожие вопросы: