ho un piccolo problema.
Devo riuscire a gestire l'errore 3024 (run-time error 3024 fil enon
trovato)
Ho un DB con FrontEnd e BackEnd.
Devo fare in modo che quando le tabelle del backend non sono collegate al
frontend mi venga gestito
l'errore e successivamente venga eseguito la procedura che ho già creato per
riallegare le tabelle.
Per chi volesse io ho creato la mia soluzione di riallega in modo tale che
tramite una finestra tipo gestione risorse seleziono il file tramite un
pulsante sfoglia e poi lui riallega tutto (invece di usare l'inserimento
manuale del percorso del file!!).
Il mio problema è che non riesco a gestire l'errore.
Ho creato una macro all'avvio (autoexec) che mi apre una maschera (so che
non è bello farlo così ma sono prove che poi ottimizzo ) alla quale è
associato il seguente codice in fase di apertura :
**********codice della maschera controllatabelle**************
Option Compare Database
Private Sub Form_Load()
Dim dbs As Database, rst As Recordset
Set dbs = CurrentDb()
On Error Resume Next
Set rst = CurrentDb.OpenRecordset("accettolicenza")
app = rst.EOF
On Error GoTo Gest_err
Gest_err:
MsgBox "Si è verificato un errore."
'If Err = 3024 Or Err = 3044 Then ' voce appositamente disabilitata in
quanto facendo un debug l'errore è sempre uguale a 0
DoCmd.OpenForm "treeview"
'End If 'appositamente disabilitato in quanto non si verifica
l'istruzione IF
End Sub
*************************fine codice********************
Quando il db viene aperto e le tabelle non sono allegate mi viene eseguita
l'apertura di un'altra maschera che si chiama treeview.
Posto il relativo codice qui di seguito :
*********codice maschera treeview*****************
Option Compare Database
Private Sub Comando2_Click()
Dim db As Database
Dim tabAllegata As TableDef
Dim i As Long
Dim Percorso As String
Set dbsFatt = CurrentDb
Dim fb As OPENFILENAME
Dim fName As Variant
Call ShowFile(Me, fb)
fName = Left(fb.lpstrFile, InStr(fb.lpstrFile, vbNullChar) - 1)
txtFile = fName
Percorso = txtFile
DoCmd.Hourglass True
If Percorso = "" Then
DoCmd.Hourglass False
Exit Sub
End If
With dbsFatt
For i = 0 To .TableDefs.Count - 1
If .TableDefs(i).Connect <> "" Then
.TableDefs(i).Connect = ";DATABASE=" & Percorso
.TableDefs(i).RefreshLink
End If
Next i
End With
DoCmd.Hourglass False
MsgBox "Le tabelle sono state ricollegate. "
Set dbsFatt = Nothing
End Sub
Private Sub Form_Load()
DoCmd.Close acForm, "controllotabelle" ' mi permette di chiudere
la maschera prima di questa che si chiama controllotabelle
End Sub
******************fine codice maschera treeview********************
Per eseguire tutto correttamente ho creato un modulo che si chiama treeview
il cui codice è il seguente :
********inizio codice modulo treeview**********
Option Compare Database
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_PATHMUSTEXIST = &H800
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long
Public Sub ShowFile(frm As Form, fb As OPENFILENAME)
Dim fName As String
Dim result As Long
Dim path As String
path = "C:\"
With fb
.lStructSize = Len(fb)
.hwndOwner = frm.Hwnd
.hInstance = 0
.lpstrFilter = "Tutti i File (*.*)" & vbNullChar & "*.mdb" &
vbNullChar
.nMaxCustomFilter = 0
.nFilterIndex = 1
.lpstrFile = Space(256) & vbNullChar
.nMaxFile = Len(.lpstrFile)
.lpstrFileTitle = Space(256) & vbNullChar
.nMaxFileTitle = Len(.lpstrFileTitle)
.lpstrInitialDir = path & vbNullChar
.lpstrTitle = "Scelta File" & vbNullChar
.flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
.nFileOffset = 0
.nFileExtension = 0
.lCustData = 0
.lpfnHook = 0
End With
result = GetOpenFileName(fb)
If result <> 0 Then
fName = Left(fb.lpstrFile, InStr(fb.lpstrFile, vbNullChar) - 1)
End If
End Sub
************fine codice modulo*************
Allora , innanzitutto devo dirvi che tutto funziona, ma l'unico problema è
che secondo il db esiste sempre l'errore (0) e quindi anche se le tabelle
sono collegate lui mi richiede di collegarle.
Sono sicuro che con qualche dritta o correzzione/aggiunta di qualche guru o
appassionato riesco a risolvere il mio problema.
Spero in bene.
Ciao da Marco
Con simpatia.
PS: AIUTATEMI VI PREGO :-(
Private Sub Form_Load()
Dim dbs As Database, rst As Recordset
On Error GoTo Gest_err
Set dbs = CurrentDb()
Set rst = CurrentDb.OpenRecordset("accettolicenza")
app = rst.EOF
a questo punto qualsiasi errore generato dalle istruzioni seguenti farà
riferimento alla sezione di gestione dell'errore che dovrai riabilitare per
"catturare" l'errore che ti interessa!
Prova e dimmi qualcosa
Alb
"MM" <mar...@libero.it> ha scritto nel messaggio
news:reGs9.56841$%M1.14...@twister2.libero.it...
Innanzitutto grazie per aver risposto.
Ho fatto le modifiche come mi hai detto (tra l'altro lo avevo provato già a
fare in tal modo)
Ti posto di seguito il codice modificato:
****inizio codice********
Private Sub Form_Load()
Dim dbs As Database, rst As Recordset
'On Error Resume Next
On Error GoTo Gest_err
Set dbs = CurrentDb()
Set rst = CurrentDb.OpenRecordset("accettolicenza")
app = rst.EOF
Gest_err:
If Err = 3024 Or Err = 3044 Then
DoCmd.OpenForm "treeview"
End If
DoCmd.Close
End Sub
*********fine codice********
L'errore viene gestito in modo corretto ma il problema è il seguente :
Premettendo che le tabelle non siano collegate in quanto il backend è stato
spostato,
in fase di appertura il db mi presenta i seguenti errori :
Impossibile trovare il file c:\................\backend.mdb --> clicco
su ok
e di nuovo mi si presenta il messaggio :
Impossibile trovare il file c:\................\backend.mdb --> clicco
su ok
e di nuovo mi si presenta il messaggio :
Impossibile trovare il file c:\................\backend.mdb --> clicco
su ok
e mi si presenta il seguente messaggio :
Errore di run-time "3024" : Impossibile trovare il file
c:\................\backend.mdb --> clicco su fine
e finisco sessione delle maschere del mio db.
Quindi non viene eseguito il db.
Ho molti dubbi , ma sono sicuro che mi hai pstato la soluzione corretta solo
che ho dubbi sulla riga
'On Error Resume Next
che ho disabilitato come vedi nel codice ma che sembra facia la differenza.
Come posso fare ?
Grazie in anticipo.
Con simpatia
marco
Ringrazio Al per la dritta !!
Dopo alcune prove e opportune modifiche sono riuscito a farlo funzionare
grazie anche al suggerimento di AL.
Per chi fosse interessato ho realizzato nel seguente modo :
*******codice modulo treeview*********
Option Compare Database
.lpstrFilter = ".MDB" & vbNullChar & "*.mdb" & vbNullChar
.nMaxCustomFilter = 0
.nFilterIndex = 1
.lpstrFile = Space(256) & vbNullChar
.nMaxFile = Len(.lpstrFile)
.lpstrFileTitle = Space(256) & vbNullChar
.nMaxFileTitle = Len(.lpstrFileTitle)
.lpstrInitialDir = path & vbNullChar
.lpstrTitle = "Scelta File" & vbNullChar
.flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
.nFileOffset = 0
.nFileExtension = 0
.lCustData = 0
.lpfnHook = 0
End With
result = GetOpenFileName(fb)
If result <> 0 Then
fName = Left(fb.lpstrFile, InStr(fb.lpstrFile, vbNullChar) - 1)
End If
End Sub
***********fine codice modulo treeview***********
**********inizio codice maschera treeview**********
Option Compare Database
Private Sub Form_Load()
Set dbsFatt = CurrentDb
Percorso = txtFile
DoCmd.Hourglass True
DoCmd.Hourglass False
MsgBox "Le tabelle sono state ricollegate. " & Chr(13) & "Riaprire il DB per
apportare le modifiche."
DoCmd.Close acForm, "controllotabelle"
Set dbsFatt = Nothing
Application.Quit
End Sub
**********fine codice maschera treeview********
*********inizio codice maschera controllatabelle**********
Option Compare Database
Private Sub Form_Load()
Dim dbs As Database, rst As Recordset
'Set dbs = CurrentDb()
'On Error Resume Next
On Error GoTo Gest_err
Set dbs = CurrentDb()
Set rst = CurrentDb.OpenRecordset("accettolicenza")
app = rst.EOF
Gest_err:
If Err = 3024 Then GoTo riallega Else
If Err = 3044 Then GoTo riallega Else
GoTo fine
riallega:
MsgBox "Le tabelle non sono collegate." & Chr(13) & "Nella schermata
successiva selezionate il DB che le contiene ! " & Chr(13) & "Se effettuate
la scelta errata poterebbe verificarsi la perdita di tutti i dati.",
vbCritical, "Ricollegare le tabelle !"
DoCmd.OpenForm "treeview", , acNormal
'End If
fine:
DoCmd.Close
End Sub
*********fine codice maschera controllatabelle*********
Il tutto viene fatto con un'istruzione aprimaschera --> controllatabelle
situato nella macro autoexec.
Ciao a tutti e grazie tante.
Con simpatia e felicità
Marco.