OutLooK 2000 macro VBA permettant de sauvegarder les messages

Salut à tous
Sous Win XP Pro
Dans OutLooK 2000 Une macro VBA me permettait de sauvegarder les messages
dans un dossier défini suivant le code ci dessous
Sub CopierMessages()
Dim OutlookApp As New Outlook.Application
Dim OutlookExp As Outlook.Explorer
Dim OutlookSélex As Outlook.Selection
Dim x As Integer
Dim i As Integer
Dim NomFichier As String
Dim NomFichierTemp As String
Dim DossierDestination As String
Dim DossierParDéfaut As String
Dim DateRéception As String
Dim fs
10 DossierParDéfaut = "C:\Sauvegarde messagerie\"
40 Set fs = CreateObject("Scripting.FileSystemObject")
50 Set OutlookApp = CreateObject("Outlook.Application")
60 Set OutlookExp = OutlookApp.ActiveExplorer
70 Set OutlookSélex = OutlookExp.Selection
80 If OutlookSélex.Count < 1 Then
90 MsgBox "Aucun message n'est sélectionné.", vbExclamation,
"Erreur"
100 Exit Sub
110 End If
130 For x = 1 To OutlookSélex.Count
170 DoEvents
180 DateRéception = OutlookSélex.Item(x).ReceivedTime
190 NomFichier = OutlookSélex.Item(x)
200 NomFichier = NomFichier & " (" & DateRéception & ")"
210 NomFichier = Remplacement(NomFichier, "/", ".")
220 NomFichier = Remplacement(NomFichier, "\", "_")
230 NomFichier = Remplacement(NomFichier, ":", ".")
240 NomFichier = Remplacement(NomFichier, "*", "_")
250 NomFichier = Remplacement(NomFichier, "?", "_")
260 NomFichier = Remplacement(NomFichier, Chr(34), "_")
270 NomFichier = Remplacement(NomFichier, "<", "_")
280 NomFichier = Remplacement(NomFichier, ">", "_")
290 NomFichier = Remplacement(NomFichier, "|", "_")
300 i = 1
310 NomFichierTemp = NomFichier
320 On Error GoTo Erreur
330 Do While fs.FileExists(DossierDestination & NomFichier &
".msg") = True
340 NomFichier = NomFichierTemp & " - " & i
350 i = i + 1
360 Loop
370 OutlookSélex.Item(x).SaveAs DossierDestination & NomFichier &
".msg"
380 NomFichier = NomFichierTemp
390 OutlookSélex.Item(x).FlagStatus = 1
400 OutlookSélex.Item(x).Save
410 Next x
420 GoTo Fin
430 End
Erreur:
440 MsgBox "Le dossier que vous avez indiqué (" & DossierDestination &
") n'existe pas." _
& Chr(10) & "Les messages n'ont pas été copiés.", vbOKOnly,
"Erreur"
Fin:
End Sub
-----------------------------------------
Function Remplacement(ByVal Texte As String, CarARemplacer As String,
CarRemplacement As String) As String
Dim c As Integer
Do
c = InStr(Texte, CarARemplacer)
If c Then
Texte = Left(Texte, c - 1) + CarRemplacement + Mid(Texte, c +
Len(CarARemplacer))
End If
Loop While c
Remplacement = Texte
End Function
+++++++++++++++++++++++
Quand je lance l'execution, à la ligne 50, j'ai un message d'erreur
erreur dexécution '-2147024770(8007007e)':

Erreur Automation
Le module spécifié est introuvable.

Merci de me dépanner
Philzig