Newsgroup: it.comp.appl.access
Titolo: problema riferimento

Ciao,
Ho il seguente problema:
Ho un file 1.mde in cui alcune tabelle si trovano come riferimento in un 
altro file 2.mde che si trova in un percorso differente da 1.mde. Quando il 
setup viene eseguito con un percorso di default come il mio ambiente di 
sviluppo tutto ok.
Il problema è che il file 1.mdb non riesce a trovare il riferimento del file 
2.mde quando questo setup viene installato in una cartella diversa dal 
default (Es: C:\TuoProgramma invece si C:\MioProgramma). Come si possono 
creare riferimenti dinamici?
La cosa strana e che la mia applicazione funzionava con 97 mentre con 2003 
mi da il sopracitato errore.
grazie 

Devi utilizzare la funzione riallegaBE, richiamandola da tasto
funzione, pulsante su maschera, o automaticamente all'apertura del db.
all'avvio della funzione ti verrà chiesto dove risiede il database di
appoggio.
'----------------------------------------------------------------------------------------------------------------------------
Option Compare Database
Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function
Function riallegabe()
   Dim intI As Integer, intJ As Integer, dbs As Database, tdf As
TableDef, path As String
    Dim sNomeDB As String, intK As Integer, lRefr As Boolean
    Dim tdfNew As TableDef, dbNew As Database, stPwd As String, aDB(1
To 50, 1 To 3) As String
    For intI = 1 To UBound(aDB)
      aDB(intI, 1) = ""
      aDB(intI, 2) = ""
      aDB(intI, 3) = ""
    Next intI
    Set dbs = CurrentDb()
    With dbs
      For Each tdf In .TableDefs
        If tdf.Connect > "" Then
           sNomeDB = ""
           For intJ = 1 To Len(tdf.Connect)
             If InStr(1, Right$(tdf.Connect, intJ), "\") > 0 Then
                sNomeDB = Mid$(tdf.Connect, Len(tdf.Connect) - intJ +
2)
                If InStr(1, sNomeDB, ";") > 0 Then
                  sNomeDB = Left$(sNomeDB, InStr(1, sNomeDB, ";") - 1)
                End If
                Exit For
             End If
           Next intJ
           For intI = 1 To UBound(aDB)
             If aDB(intI, 1) = sNomeDB Then
                Exit For
             Else
                If aDB(intI, 1) = "" Then
                   aDB(intI, 1) = sNomeDB
                   path = Left$(tdf.Connect, InStr(1, tdf.Connect, "\"
& sNomeDB) - 1)
                   If InStr(1, path, ":\") > 0 Then
                      path = Mid$(path, InStr(1, path, ":\") - 1)
                   Else
                      If InStr(1, path, "\\") > 0 Then
                         path = Mid$(path, InStr(1, path, "\\"))
                      End If
                   End If
                   aDB(intI, 2) = path
                   stPwd = ""
                   If InStr(1, tdf.Connect, ";PWD=") > 0 Then
                      stPwd = Mid$(tdf.Connect, InStr(1, tdf.Connect,
";PWD="))
                      stPwd = Left$(stPwd, IIf(InStr(2, stPwd, ";") >
0, InStr(2, stPwd, ";") - 1, Len(stPwd)))
                   End If
                   aDB(intI, 3) = stPwd
                   Exit For
                End If
             End If
           Next intI
        End If
      Next tdf
    End With
    For intI = 1 To UBound(aDB)
      If aDB(intI, 1) > "" Then
         path = BrowseFolder("Percorso corrente: " & aDB(intI, 2) & "\"
& aDB(intI, 1))
         If Nz(path, "") > "" Then
            If Dir(path & "\" & aDB(intI, 1)) > "" Then
               path = Trim$(path)
               If Right$(path, 1) = "\" Then
                  path = Left$(path, Len(path) - 1)
               End If
               aDB(intI, 2) = path
            Else
               MsgBox "La cartella selezionata non contiene il database
" & aDB(intI, 1), vbCritical
               intI = intI - 1
            End If
         End If
      Else
         Exit For
      End If
    Next intI
    DoCmd.Hourglass True
    With dbs
      For Each tdf In .TableDefs
        lRefr = False
        sNomeDB = ""
        If tdf.Connect > "" Then
           For intJ = 1 To Len(tdf.Connect)
             If InStr(1, Right$(tdf.Connect, intJ), "\") > 0 Then
                sNomeDB = Mid$(tdf.Connect, Len(tdf.Connect) - intJ +
2)
                If InStr(1, sNomeDB, ";") > 0 Then
                   sNomeDB = Left$(sNomeDB, InStr(1, sNomeDB, ";") - 1)
                End If
                Exit For
             End If
           Next intJ
           For intK = 1 To UBound(aDB)
             If Trim$(aDB(intK, 1)) = Trim$(sNomeDB) Then
                Set dbNew = OpenDatabase(aDB(intK, 2) & "\" & aDB(intK,
1), False, False, aDB(intK, 3))
                With dbNew
                  For Each tdfNew In .TableDefs
                    If tdfNew.name = 
tdf.name
 Then
                        tdf.Connect = Left$(tdf.Connect, IIf(InStr(1,
tdf.Connect, ":") > 0, _
                           InStr(1, tdf.Connect, ":") - 2, InStr(1,
tdf.Connect, "\\") - 1)) & _
                           Trim$(aDB(intK, 2)) & "\" & aDB(intK, 1) & _
                           Mid$(tdf.Connect, InStr(1, tdf.Connect,
sNomeDB) + Len(Trim$(sNomeDB)))
                       tdf.RefreshLink
                       lRefr = True
                       Exit For
                    End If
                  Next tdfNew
                End With
                dbNew.Close
                Set dbNew = Nothing
                Exit For
             End If
           Next intK
           If Not lRefr Then
              MsgBox "Tabella " & 
tdf.name
 & " non trovata nel
database"
           End If
        End If
      Next tdf
    End With
    DoCmd.Hourglass False
End Function
'------------------------------------------------------------------------------------------------------------------------