Predmet:Re: Relink sa više kompjutera
PreuzmiIzvorni kôd (Visual Basic):Function Relink2()
Dim Db As Database
Dim Tdf As TableDef
Dim SQL As String
Dim Rs As Recordset
Dim Rst As Recordset
Dim ImeTabele As String
Dim Putanja As String
Dim PutanjaORg As String
Dim Link As Boolean
Dim R
On Error Resume Next
Set Db = CurrentDb
SQL = "SELECT Name FROM MSysObjects WHERE Database<>Null"
Set Rs = Db.OpenRecordset(SQL)
Do While Not Rs.EOF
ImeTabele = Rs!Name
Set Rst = Db.OpenRecordset("SELECT * FROM " & ImeTabele & " WHERE False<>False")
Rst.Close
If err.Number > 0 Then
MsgBox "Nema konekcije na baze"
Link = False
err = 0
Rs.Close
GoTo RELINK_TABELA
End If
Rs.MoveNext
Loop
Rs.Close
Exit Function
RELINK_TABELA:
SQL = "SELECT Database,Name FROM MSysObjects WHERE Database<>Null ORDER By Database"
Set Rs = Db.OpenRecordset(SQL)
Do While Not Rs.EOF
ImeTabele = Rs!Name
Putanja = Rs!Database
START_LINK:
If Link = False Then
Dim iResponse As String
R = MsgBox("Vjerovatno putanja nije ispravna." & vbCrLf _
& "Želiš li odabrati novu putanj za tabelu: " & ImeTabele & "? ", _
vbOKCancel + vbInformation + vbApplicationModal + vbDefaultButton1, _
Putanja)
If R = vbOK Then
PutanjaORg = NadjiBazu("")
Else
Quit
End If
End If
Set Tdf = Db.TableDefs(ImeTabele)
Tdf.Connect = ";DATABASE=" & PutanjaORg
err = 0
Tdf.RefreshLink
If err <> 0 Then
Link = False
GoTo START_LINK
Else
Link = True
End If
Rs.MoveNext
Loop
End Function
Ovu proceduru trebas pozvati pri podizanju baze.
Netrebaju ti vise tvoje procedure:
RelinkTables1
RefreshLinks1
ProvjeraLinka
IsLinked
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.