Prikazi cijelu temu 20.02.2014 18:41
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: Relink sa više kompjutera
PreuzmiIzvorni kôd (Visual Basic):
  1. Function Relink2()
  2. Dim Db As Database
  3. Dim Tdf As TableDef
  4. Dim SQL As String
  5. Dim Rs As Recordset
  6. Dim Rst As Recordset
  7. Dim ImeTabele As String
  8. Dim Putanja As String
  9. Dim PutanjaORg As String
  10. Dim Link As Boolean
  11. Dim R
  12.  
  13. On Error Resume Next
  14. Set Db = CurrentDb
  15. SQL = "SELECT Name FROM MSysObjects WHERE Database<>Null"
  16. Set Rs = Db.OpenRecordset(SQL)
  17. Do While Not Rs.EOF
  18. ImeTabele = Rs!Name
  19. Set Rst = Db.OpenRecordset("SELECT * FROM " & ImeTabele & " WHERE False<>False")
  20. Rst.Close
  21.     If err.Number > 0 Then
  22.     MsgBox "Nema konekcije na baze"
  23.     Link = False
  24.     err = 0
  25.     Rs.Close
  26.     GoTo RELINK_TABELA
  27.     End If
  28. Rs.MoveNext
  29. Loop
  30. Rs.Close
  31. Exit Function
  32. RELINK_TABELA:
  33. SQL = "SELECT Database,Name FROM MSysObjects WHERE Database<>Null ORDER By Database"
  34. Set Rs = Db.OpenRecordset(SQL)
  35.  
  36. Do While Not Rs.EOF
  37. ImeTabele = Rs!Name
  38. Putanja = Rs!Database
  39. START_LINK:
  40. If Link = False Then
  41. Dim iResponse As String
  42. R = MsgBox("Vjerovatno putanja nije ispravna." & vbCrLf _
  43. & "ŽeliÅ¡ li odabrati novu putanj za tabelu: " & ImeTabele & "?  ", _
  44. vbOKCancel + vbInformation + vbApplicationModal + vbDefaultButton1, _
  45. Putanja)
  46.     If R = vbOK Then
  47.     PutanjaORg = NadjiBazu("")
  48.     Else
  49.     Quit
  50.     End If
  51. End If
  52. Set Tdf = Db.TableDefs(ImeTabele)
  53. Tdf.Connect = ";DATABASE=" & PutanjaORg
  54. err = 0
  55. Tdf.RefreshLink
  56.     If err <> 0 Then
  57.     Link = False
  58.     GoTo START_LINK
  59.     Else
  60.     Link = True
  61.     End If
  62. Rs.MoveNext
  63. Loop
  64. End Function

Ovu proceduru trebas pozvati pri podizanju baze.
Netrebaju ti vise tvoje procedure:
RelinkTables1
RefreshLinks1
ProvjeraLinka
IsLinked
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.