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
| ' Quelques déclarations
Dim MyDB As DAO.Database
Dim MySetDetailFile As DAO.Recordset
Dim MySetTable As DAO.Recordset
Dim wFSO As New FileSystemObject
Dim wFil As File
Dim wDossier As Folder
Dim wApp As New Word.Application
Dim wDoc As Word.Document
Dim FilName As String
Private Sub cmdImporterFiches_Click() '*************************************
' Identifie les fichiers présents dans le dossier d'extraction de courriels,
' traite le contenu et le déplace vers le dossier des Traités
' Répertoires des Inscriptions : champs dans le formulaire d'appel
On Error GoTo HandleErrors
Set wDossier = wFSO.GetFolder(Me.ctlChemin)
For Each wFil In wDossier.Files
If Left(wFil.Name, 9) = Me.ctlPréfixe Then
Extract (wFil.Name)
If SwOK = True Then ' 1er fichier intraitable
wFil.Move Me.ctlChemin & Me.ctlFichesTraitées
Else
Exit For
End If
End If
Next wFil
Set wDoc = Nothing
Set wFSO = Nothing
Set wApp = Nothing
ExitHere:
Exit Sub
HandleErrors:
HandleErrors Err.Number, "cmdImporterFiches_Click"
Resume ExitHere
End Sub
Public Function Extract(oFN As String) '*************************************
On Error GoTo HandleErrors
GoSub Initialisation ' <==<==<==<==<==<== ERREUR
wDoc.Unprotect (PWD) ' protection par mot de passe
intI = wDoc.FormFields.Count ' nombre de champs
' j'ai sauté le code des tests sur les noms et structures des documents Word
' et les traitements des fichiers car l'erreur se produit avant !
AbortHere:
wDoc.Close SaveChanges:=False
MySetDetailFile.Close
Set MySetDetailFile = Nothing
MySetTable.Close
Set MySetTable = Nothing
Set wDoc = Nothing
wApp.Quit
Set wApp = Nothing
Set MyDB = Nothing
ExitHere:
Exit Function
HandleErrors:
HandleErrors Err.Number, "Extract"
SwOK = False
Resume AbortHere
Initialisation:
' je n'ai pas inclus l'initialisation des constantes
SwOK = True
Set MyDB = CurrentDb() ' <==<==<==<==<==<== ERREUR
Set wDoc = wApp.Documents.Open(FileName:=Me.ctlChemin & oFN)
Set MySetDetailFile = MyDB.OpenRecordset(KfilNamDL) ' tlkpDétailListe
Return
End Function '--------------------------------------------------------------- |
Partager