Ho un problema di probabile caduta connessioneverso Access.
Sto creando una piccola applicazione utilizzando excel e access.
Nel Modulo Ho creato una sub in cui Effettuo la connessione.
' definizioni delle variabili utilizzabili in tutta l'applicazione
Public oConn As ADODB.Connection
Public rs1 As ADODB.Recordset
Public strConn As String
Public FieldKeyRic As Variant
Public FieldoutRicerca As String
Public Strsql_Ric As String
Public NSel As Integer
Public Ncampi As Integer
Public SelezionatoCampodaElenco As Boolean
Public NameClienteNew As String
Public TipoSearch As String ' S=Selettiva G=Generica
Public ArkSearch As String ' Archivio di ricerca L=Località C=Clienti
Public TipoArk As String ' D = Da Ritirare R = Rilasciato
Public DateKeyRic As Date
Public txtChiamante As Integer ' numero della txtbox chiamante per frmzoom
Public UserLogged As Long ' utente che si è loggato
Public Commarea As String ' salvo il txt chiamante tra frmritiro e frmCliente
Public PathUser As String
-------------------------------------------- metodo per la connessiione a access
Public Function GM_ConnMDB()
Dim oConn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim PathUser As String
PathUser = ActiveWorkbook.Path & "\Covesap.accdb;"
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathUser & "Persist Security Info=False;"
' Crea e apri la connessione
Set oConn = New ADODB.Connection
oConn.Open strConn
End Function
la prima form che utilizzo è la frmLogin in cui immetto le credenziali d'accesso. <--------------- funziona e riesco ad accedere al db controllando i dati d'accesso.
effettuato il login apro la formGestione in cui devo inserire i dati specifici dell'applicazione.
la logica applicativa prevede di effettuare una ricerca per vissualizzare un elenco con i record inseriti in tabella.
Private Sub btnElenco_Click()
' ricerca operazioni inserite
Dim rs3 As ADODB.Recordset
Dim strSQL As String
Dim Parametro As String
' imposto i campi per la gestione delle ricerche per generare elenchi
SelezionatoCampodaElenco = False
NSel = 1
Ncampi = 4
Strsql_Ric = " SELECT Pratica.ID, Pratica.Utente, Pratica.Intervento, T_Stato_Pratica.D_Stato_Pratica " & _
" FROM T_Stato_Pratica INNER JOIN Pratica ON T_Stato_Pratica.ID_Stato_Pratica = Pratica.Stato " & _
" ORDER BY Pratica.Utente"
frmRicerca.InitializeStrsql Strsql_Ric ' passo la stringa da eseguire sulla form geenerica di elenco
frmRicerca.Show vbModal
txtUtente = ""
If SelezionatoCampodaElenco Then
txtPratica = FieldKeyRic
Else
Inizializza
MsgBox "Nessuna selezione operata dall'utente", vbExclamation
End If
End Sub
nella pagina "frmRicerca" in cui effettuo la lettura dei dati contenuti nella Strsql_ric passata, effettuo la connessione e qui va in errore.
Private Sub UserForm_Activate()
' Visualizzazione sulla Listbox1 delle Tabelle utente
' le tabelle prese in considerazione sono solo quelle con i prefissi Tb_Azienda_XXXXXXX
' es. Tb_Azienda_Assimoco, Tb_Azienda_ICCREA_Stampe
Dim rs1 As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim strSQL As String
Dim NLoop As Integer
strSQL = Strsql_Ric
MsgBox "frmRicerca -- UserFormActivate -- devo fare connessione"
GM_ConnMDB
On Error GoTo ErrorHandler
NLoop = 0
ListBox1.Clear
ListBox1.RowSource = ""
ListBox1.ColumnCount = Ncampi
Set rs1 = oConn.Execute(Strsql_Ric)
Do Until rs1.EOF
Select Case NSel
Case 1
ListBox1.AddItem rs1("Id") & vbTab '"ROSSI" cognome in riga 1 colonna 1
ListBox1.List(NLoop, 1) = rs1("Utente")
ListBox1.List(NLoop, 2) = rs1("Intervento")
ListBox1.List(NLoop, 3) = rs1("D_Stato_Pratica")
' Case 2
' ListBox1.AddItem rs1("ID_StatoRitiro") ' & vbTab '"ROSSI" cognome in riga 1 colonna 1
' ListBox1.List(NLoop, 1) = rs1("D_StatoRitiro")
' Case 3
' ' da personalizzare
' Case 4
' ' da personalizzare
Case Else
End Select
NLoop = NLoop + 1
rs1.MoveNext
Loop
rs1.Close
Set rs1 = Nothing
If NLoop = 0 Then
ListBox1.Clear
ListBox1.RowSource = ""
ListBox1.ColumnCount = 1
ListBox1.AddItem "Nessun Record presente per la selezione Impostata" '"ROSSI" cognome in riga 1 colonna 1
End If
ErrorHandler:
If Not oConn Is Nothing Then
MsgBox "esco per --------------------> mancata connessione"
If oConn.State = adStateOpen Then oConn.Close
End If
Set oConn = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If
End Sub
daallo screenshot si vede che manca la connessione.
Non capisco perchè, dopo aver eseguito il metodo "GM_ConnMDB" in cui creo la connessione, esco per mancata connessione.
Potete aiutarmi ?
Sono in un errore bloccante.
Disponibile ad ogni chiarimento
Grazie
Moreno