Newsgroup: it.comp.appl.access
Titolo: collegamento tabelle ad as400

io ho copiato e modificato la stringa di accesso di questa funzione per 
potermi collegare ai file as 400....
premetto non sono esperto in access...
qualcuno potrebbe dirmi dove cč un errore....lanciando la funzioen mi dice 
sempre impossibile connettersi al server....
grazie  a tutti
Public Const fForm = "Forms"
Public Const fReport = "Reports"
Public Const fMacro = "Scripts"
Public Const fModulo = "Modules"
Public Const fTabella = "Tables"
Public Const fQuery = "Queries"
Private Const cCnnString As String = "ODBC;DRIVER={Client Access ODBC Driver 
(32-bit)};SYSTEM=AS400SARI;UID=QSECOFR;PWD=QSECOFR;"
'*
'*Private Const cCnnString As String = 
"ODBC;DSN=servjob;uid=qsecofr;pwd=qsecofr;"
Private Const cLnkTbl As String = "LinkedTables"
Private Function LinkODBCTbl() As Boolean
   On Error GoTo Err_RlnkODBCTbl
   Dim tdf As DAO.TableDef
   Dim rs As DAO.Recordset
   Dim S As String
   Dim strSQL As String
   LinkODBCTbl = False
   strSQL = cLnkTbl
   Set rs = CurrentDb.OpenRecordset(strSQL)
   rs.MoveFirst
   Do Until rs.EOF
      S = rs.Fields(0).Value
      If Esiste_Oggetto(S, fTabella) Then _
            CurrentDb.TableDefs.Delete S
      Set tdf = CurrentDb.CreateTableDef(S)
      tdf.connect = cCnnString
      tdf.SourceTableName = S
      CurrentDb.TableDefs.Append tdf
      Set tdf = Nothing
      rs.MoveNext
   Loop
   LinkODBCTbl = True
Exit_Here:
   rs.Close
   Set rs = Nothing
   Set tdf = Nothing
   Exit Function
Err_RlnkODBCTbl:
   LinkODBCTbl = False
   MsgBox "Impossibile connettersi al Server"
   Resume Exit_Here
End Function
Public Function Esiste_Oggetto(ByVal Nome_Ogg As String, _
                               Typ_Ogg As String, Optional ByVal Nome_Dbs As 
String = "") As Boolean
   Dim dbs As Database
   Dim tdf As TableDef
   Dim qdf As QueryDef
   Dim X, num_ogg As Integer
   If Nome_Dbs = "" Then
      Set dbs = CurrentDb
   Else
      Set dbs = OpenDatabase(Nome_Dbs)
   End If
   Select Case Typ_Ogg
      Case fTabella
         For Each tdf In dbs.TableDefs
            If tdf.Name = Nome_Ogg Then
               Esiste_Oggetto = True
               dbs.Close
               Set dbs = Nothing
               Exit Function
            End If
         Next tdf
      Case fQuery
         For Each qdf In dbs.QueryDefs
            If qdf.Name = Nome_Ogg Then
               Esiste_Oggetto = True
               dbs.Close
               Set dbs = Nothing
               Exit Function
            End If
         Next qdf
      Case fForm, fModulo, fMacro, fReport
        num_ogg = dbs.Containers(Typ_Ogg).Documents.Count
        For X = 0 To num_ogg - 1
           If dbs.Containers(Typ_Ogg).Documents(X).Name = Nome_Ogg Then
             Esiste_Oggetto = True
             dbs.Close
             Set dbs = Nothing
             Exit Function
           End If
        Next
   End Select
Esci:
   Esiste_Oggetto = False
   dbs.Close
   Set dbs = Nothing
End Function

 qualcuno potrebbe dirmi dove cè un errore....lanciando la funzioen mi dice


 ha scritto nel messaggio
-- 
_ _
Ciao
MAssimiliano Amendola            
www.accessgroup.it
Cisa - Conferenza Italiana per Sviluppatori Access
Info:  
www.donkarl.com/it