Bonjour,
Tout d'abord j'ai bien verifié cela:
http://vb.developpez.com/faq/?page=IDE#on_error_goto

Le problème c'est que ca marche la premiere fois dans la boucle mais la 2eme...
En resumé , à la première iteration ma base etant lockée , une erreur est lancée et je vais bien au label skip...mais pour la 2eme base malgré la gestion de l'erreur , j'ai bien un msg...

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 
Sub test()
 
 
'******************************************
' Script qui compacte une base de données
' Ne pas oblier de changer les variables
'******************************************
 
Dim objScript
Dim objAccess
Dim strPathToMDB, strPathToMDBs
Dim strMsg
Dim strPassword
Dim BACKUP, PROD, logfile
 
' initialisation
BACKUP = "H:\backup\"
PROD = "H:\Replicat\"
logfile = "H:\temp\log.txt"
'******** NOTE:  Variable à éditer **********
'
' Path du fichier à compacter
    strPathToMDBs = Array("Report.mdb", "Sophis.mdb", "BLACKBOX.mdb", "DATA MARKET.mdb")
 
' Path du fichier Temporaire
    strTempDB = "H:\temp.mdb"
'
' Mot de passe de la BD
    strPasswords = Array("infocentre", "", "drm", "")
' Pour Access 2000
Set objAccess = CreateObject("Access.Application.11")
 
Set objScript = CreateObject("Scripting.FileSystemObject")
'8 => Append mode
Set MonFic = objScript.OpenTextFile(logfile, 8, True)
 
 With MonFic
 .writeLine Time & " Start"
    ' Gestion de l'erreur base de donné ouverte
 For i = 0 To UBound(strPathToMDBs)
   On Error GoTo Skip
 
   'On fait un BackUP
   .writeLine "Starting copying file : " & strPathToMDBs(i)
   objScript.CopyFile PROD & strPathToMDBs(i), BACKUP & strPathToMDBs(i), True
    If strPasswords(i) <> "" Then
        strPassword = ";pwd=" & strPasswords(i)
        .writeLine Time & " " & PROD & strPathToMDBs(i) & "  ==> " & strTempDB
        objAccess.DBEngine.CompactDatabase PROD & strPathToMDBs(i), strTempDB, , , strPassword
        .writeLine Time & " " & strPathToMDBs(i) & " has been compacted"
 
    Else
        'On Error GoTo 0
        Err.Clear
        On Error GoTo Skip
        .writeLine Time & " " & PROD & strPathToMDBs(i) & "  ==> " & strTempDB
        objAccess.DBEngine.CompactDatabase PROD & strPathToMDBs(i), strTempDB
        .writeLine Time & " " & strPathToMDBs(i) & " has been compacted"
    End If
 
 
 
 
    .writeLine Time & " Replacing " & strPathToMDBs(i)
    objScript.CopyFile PROD & strPathToMDBs(i), PROD & strPathToMDBs(i) & "z", True
    objScript.CopyFile strTempDB, PROD & strPathToMDBs(i), True
    .writeLine Time & " Deleting Temp File for " & strPathToMDBs(i)
    objScript.DeleteFile strTempDB
    objScript.DeleteFile PROD & strPathToMDBs(i) & "z"
 
Skip:
    If Err.Number <> 0 Then
    .writeLine Time & Err.description
    Err.Clear
    End If
 Next
 
    ' On vide les objets
    Set objAccess = Nothing
    Set objScript = Nothing
    .writeLine Time & " End"
 End With
 
MsgBox "Traitement fini à " & Time
End Sub

Merci