הנושאים החמים
הנושאים החמים
סליחה מכל מי שטרח להביא לי קוד פתאום נזכרתי שיש לי קובץ מפעם, סליחה
מצאתי עוד איזה קוד אצלי שמחבר בין טבלאות אבל משום מה הוא לא עובר על כל הטבלאות המקושרות ומקשר אותם למסד הנתונים שציינתי, אלא מקשר רק אחת מהטבלאות [לקחתי אותו בעבר מקובץ שפרסם
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תודה רבה,אשמח לתיקון הבעיה פשוט יש לי קובץ מוכן לצרכים שלי, רק זה הבעיה.
אהבתי את הרעיון, תודה רבה!
