עדכון טבלאות מקושרות ע"י קוד

[לוי א]

האם ישנה אפשרות לעדכן את מקור הנתונים של טבלאות מקושרות על ידי קוד?
בתודה

 

[מ.ש.]

Public Function RelinkTables(new_path As String, old_path As String)
    Dim ConnectStr As String, Pos As Integer
    Dim rs As DAO.Recordset
    Dim tD As DAO.TableDef
    Dim openedConn As Boolean
    For Each tD In CurrentDb.TableDefs
        On Error Resume Next
        If (tD.Attributes And dbAttachedTable) = dbAttachedTable Then
 '       MsgBox tD.Connect
        If tD.Connect = old_path Then
            Pos = InStr(1, tD.Connect, "DATABASE=")
            ConnectStr = Right(tD.Connect, Len(tD.Connect) - Pos - 8)
            If LCase(ConnectStr) <> LCase(new_path) Then
                DoCmd.Echo False, "Refreshing: " & tD.name
                  '  tD.Connect = ";DATABASE=" & new_path
                  tD.Connect = new_path
                    On Error Resume Next
                    tD.RefreshLink
                    On Error GoTo 0
                On Error Resume Next
                    'After relinking first table - we open a connection to the database in order to increase the speed of relinking
                    If Not openedConn Then
                        Set rs = CurrentDb.OpenRecordset("select * from " & tD.name, adOpenDynamic)
                        openedConn = True
                    End If
         End If
                On Error GoTo 0
            End If
        End If
       On Error GoTo 0
    Next
    If openedConn Then
        rs.Close
        Set rs = Nothing
    End If
    DoCmd.Echo True
End Function

 

[לוי א]

תודה!
זה לא עובד משום מה, אני קורא לפונקציה ומזין בארגומנט הראשון את הנתיב החדש, ובארגומנט השני את הנתיב הישן והוא לא מחליף בינהם

 

[FullTime]

בקוד הזה תצטרך לעדכן רק את הנתיב החדש.

Sub Startup(strPath As String)
    On Error GoTo Startup_Err

    Dim tdf As DAO.TableDef
    Dim strTest As String

    For Each tdf In CurrentDb.TableDefs

        If Len(Nz(tdf.Connect, "")) > 0 Then
                tdf.Connect = (";DATABASE=" & strPath)
                tdf.RefreshLink
        End If
    Next

Startup_Exit:
    Exit Sub

Startup_Err:
    MsgBox Err.Description
    Resume Startup_Exit
End Sub

הקוד לא מתאים לטבלאות שמקושרות ליותר מDB אחד

 

[לוי א]

תודה
הקוד הנ"ל משנה את המיקום של כל הטבלאות לאותו קובץ
השאלה מה קורה כשיש 2 טבלאות שכל אחת מקושרת לקובץ אחר

 

[FullTime]

מה קורה? הוא יחזיר שגיאה...

אם שני קבצי הנתונים הם באותה תקיה,
אפשר לעשות Loop שיבדוק על הטבלה לאיזה קובץ הוא מקושר,
ואז ב txtpath תצטרך לכתוב רק את התקיה.

 

[לוי א]

אכן אין לי בעיה שיחזיר שגיאה, רק שיש לי בעיה במקרה בו יש לי 2 טבלאות בקובץ שלי, וכל טבלה מקושרת לקובץ אחר, כאשר בכל אחד מהם יש את שני הטבלאות שבקובץ שלי, כך יוצא שאם אני יריץ את הקוד הוא יעדכן בתחילה את שניהם לקובץ הראשון ולאחר מכן את שניהם לקובץ השני

 

[FullTime]

אז אתה צריך משהו אחר, והתוכנית הכתובה לעיל, לא תעזור לך.

כדי להגיע למה שאתה צריך,
תוכל לעשות טבלה מקומית [לא מקושרת] שבה תכתוב את שם הטבלה ואת נתיב המקור.
ואז, במקום לעבור על כל הטבלאות כך,
For Each tdf In CurrentDb.TableDefs
תביא rs על הטבלה המקומית, שתקשר כל טבלה למיקומה הנכון.

או, אם הם רק שני טבלאות, תעשה 2 שורות כאלו:
[שם טבלה].Connect = (";DATABASE=" & strPath)