למה לפצל את מסד הנתונים

הנושא בפורום 'פורום תוכנות מייקרוסופט אופיס' פורסם ע"י חיים יודלביץ, ‏10/1/18.

  1. חיים יודלביץ

    חיים יודלביץ משתמש רשום

    הצטרף:
    ‏18/12/17
    הודעות:
    68
    תודות :
    18
    נקודות:
    9
    סליחה מכל מי שטרח להביא לי קוד פתאום נזכרתי שיש לי קובץ מפעם, סליחה

    מצאתי עוד איזה קוד אצלי שמחבר בין טבלאות אבל משום מה הוא לא עובר על כל הטבלאות המקושרות ומקשר אותם למסד הנתונים שציינתי, אלא מקשר רק אחת מהטבלאות [לקחתי אותו בעבר מקובץ שפרסם
    HUBHCBH ושניתי דברים בקוד ועכשיו זה לא עובד]מישהו יכול לעזור לי מה לא נכון כאן בקוד?

    [בקוד בלחצן העיון לבחור קובץ שמה כותבים את הסיסמה לקובץ]



    קוד:
    Function RefreshLinks(MyDbName As String, pwd As String) As Boolean
    
    ' Refresh links to the supplied database. Return True if successful.
    ' Attempts to connect to mdb named in the jet datapath setting
    ' Application fails if mdb not found
    ' This demo assumes that all the linked tabled appear in the same back end
    ' Code will need to be manipulated if using side ends.
    ' Also need to ensure that Miscrosoft DAO 3.6 Object library is referenced
    
    
    'הודעת תצוגה על שרת המצב
    '   DoCmd.Echo True, "מרענן קישורי טבלה נא המתן..."
    
        Dim dbs As DAO.Database
        Dim tdf As DAO.TableDef
        Dim i As Integer
    
        '/בודק אם שם הקובץ קיים
        If Dir(MyDbName) = "" Then
            MsgBox "לא ניתן לפתוח את מסד הנתונים שצויין!", vbMsgBoxRtlReading + vbCritical + vbMsgBoxRight, "חיבור מסד הנתונים"
            Exit Function
        End If
    
        ' לולאה דרך כל הטבלאות הנמצאים בבסיס הנתונים.
        Set dbs = CurrentDb
        For i = 0 To dbs.TableDefs.Count - 1
            Set tdf = dbs.TableDefs(i)
            CurrentDb.Containers("Tables").Documents.Refresh
        Next i
        On Error Resume Next
        Err = 0
        ' If the table has a connect string, it's a linked table.
        'בתרגום לעברית: אם השולחן יש להתחבר המחרוזת שלה טבלה מקושרת
        If Len(tdf.Connect) > 0 Then
            If tdf.Connect <> ";DATABASE=" & MyDbName & ";PWD=" & pwd Then
                tdf.Connect = ";DATABASE=" & MyDbName & ";PWD=" & pwd
                tdf.RefreshLink           '   לקשר מחדש את הטבלה
                If Err <> 0 Then
                    RefreshLinks = False
                    MsgBox "לא ניתן להתחבר למסד הנתונים שצויין!" & vbCrLf & "מאחת או יותר מהסיבות דלהלן," _
                           & vbCrLf & "1. הסיסמה שגויה." _
                           & vbCrLf & "2. אין טבלאות מתאימות לחיבור במסד הנתונים שבקשת להתחבר אליו." _
                           & vbCrLf & vbCrLf & "מיקום הקובץ: " & MyDbName, vbMsgBoxRtlReading + vbCritical + vbMsgBoxRight, "חיבור מסד הנתונים"
                    Exit Function
                End If
                Set dbs = Nothing
                Set tdf = Nothing
                RefreshLinks = True         ' Relinking complete. בתרגום לעברית: לקשר מחדש מלאה
                MsgBox "מסד הנתונים קושר בהצלחה!" & vbCrLf & "לקובץ: " & "" & MyDbName, vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "חיבור מסד הנתונים"
            End If
        End If
    End Function
    
    Public Function DropLinks()
    
        Dim tdf As DAO.TableDef
        Dim strConnect As String
    
        For Each tdf In CurrentDb.TableDefs
            strConnect = tdf.Connect
            ' If the table has a connect string, it's a linked table.
            If Len(strConnect) > 0 Then
                DoCmd.DeleteObject acTable, tdf.Name
            End If
        Next tdf
    
    End Function
    
    Public Sub test()
    
        Dim tdf As DAO.TableDef
        Dim strConnect As String
    
        For Each tdf In CurrentDb.TableDefs
            strConnect = tdf.Connect
            If Len(strConnect) > 0 Then
                Debug.Print "[" & tdf.Name & "] linked to: " & Right$(strConnect, Len(strConnect) - InStrRev(strConnect, "="))
                'Debug.Print "[" & tdf.Name & "] linked to: " & strConnect
            End If
        Next
    
    End Sub
    
    תודה רבה,אשמח לתיקון הבעיה פשוט יש לי קובץ מוכן לצרכים שלי, רק זה הבעיה.

    אהבתי את הרעיון, תודה רבה!
     
  2. makalot

    makalot משתמש חדש

    הצטרף:
    ‏26/4/15
    הודעות:
    21
    תודות :
    0
    נקודות:
    2
    בכל מקרה, אם זה עדיין בשלבי בנייה אין טעם לפצל, כל האמור לעיל היא לעבודה בזמן אמת, או לקראת ההפצה.
    אחרת, תתקשה עם כל שינוי בשדות בטבלאות
     
  3. חיים יודלביץ

    חיים יודלביץ משתמש רשום

    הצטרף:
    ‏18/12/17
    הודעות:
    68
    תודות :
    18
    נקודות:
    9
    אני ממש עומד להעביר את הקובץ.
    תודה.
     
  4. a26955

    a26955 משתמש מקצוען

    הצטרף:
    ‏2/1/13
    הודעות:
    2,125
    תודות :
    138
    נקודות:
    74
    תכניס את הקוד שאני הבאתי לך במודול חדש
    ובאירוע בעת פתיחה של הטופס שנפתח ראשון תכניס את המילה Startup
    את זה תוכל להכניס בכל קובץ שהוא, ולא משנה אם קובץ מוכן או לא מוכן...
     
    חיים יודלביץ אוהב/ת את זה.
  5. חיים יודלביץ

    חיים יודלביץ משתמש רשום

    הצטרף:
    ‏18/12/17
    הודעות:
    68
    תודות :
    18
    נקודות:
    9

    אבל הקוד הזה אם הבנתי נכון הוא בשביל לקשר אוטומטית את הטבלאות בעת הפתיחה [משום מה הוא לא עבד לי באקסס 2016 32 ביט יכול להיות?] ובקובץ המוכן אם מתרחשת שגיאה והקובץ לא מקושר הוא פותח חלון לקישור הקובץ מחדש וזה הקוד לקישור מחדש ע"י המשתמש, שיש לי איתו בעיה שהצגתי למעלה.

    בתודה מראש