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 87 88 89 90 91 92 93
| If UserForm1.OptionButton1 = True Then
'On Error GoTo TraiteErreur
' Création de la session Notes
'Ouverture d'une session NOTES
'Dim motpasse As String
Call Session.Initialize(motpasse) 'si pas de passwd pas de parametre pour initialize
Set dir = Session.GetDbDirectory("")
Set db = dir.OpenMailDatabase
' Dim MailDoc As Object 'The mail document itself
' Dim MailFile As Object
'
' Dim item As Object
' Dim obj As Variant
' Dim Compteur As Integer
test_date = InputBox("Date des mails a extraire (dd/mm/yyyy):", "DATE EXTRACT")
Set MailFile = db.GetView("valid comptable")
Set MailDoc = MailFile.GetLastDocument
While Range("E21").Offset(i, 0) <> "Brique 2"
ptfop = Range("E21").Offset(i, 0)
ptfh = Range("E21").Offset(i, 0) & "_1"
Do While Not (MailDoc Is Nothing)
Set item = MailDoc.GetFirstItem("Body")
If (item.Type = RICHTEXT) Then
If Not IsEmpty(item.EmbeddedObjects) Then
For Each obj In item.EmbeddedObjects
If (obj.Type = EMBED_ATTACHMENT) And (VBA.Right(obj.Name, 8) = ptfop & ".xls" Or VBA.Right(obj.Name, 10) = ptfh & ".xls") And Format(test_date, "yyyymmdd") = Format(item.LastModified, "yyyymmdd") And (VBA.Left(obj.Name, 6) = "JOURSR" Or VBA.Left(obj.Name, 5) = "HISIN" Or VBA.Left(obj.Name, 6) = "JOUROP") Then
' Dim objFSO, objDossier, objFichier
' Dim Repertoire, NomFichierTxt
test_fichier_present = False
Repertoire =EXTRACT_MAIL"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDossier = objFSO.GetFolder(Repertoire)
If (objDossier.Files.Count > 0) Then
For Each objFichier In objDossier.Files
If objFichier.Name = obj.Name Then
test_fichier_present = True
End If
Next
End If
Set objDossier = Nothing
Set objFSO = Nothing
If test_fichier_present = False Then
Call obj.ExtractFile("EXTRACT_MAIL\" + obj.Name)
End If
End If
Next
End If
End If
Set MailDoc = MailFile.GetPrevDocument(MailDoc)
If DateDiff("d", Format(Now() - 15, "dd/mm/yy"), Format(item.LastModified, "dd/mm/yy")) < 0 Then
Set MailDoc = Nothing
End If
Loop
i = i + 1
Wend
Set object = Nothing
Set rtitem = Nothing
Set doc = Nothing
Set db = Nothing
Set Session = Nothing
Set MailFile = Nothing
Set MailDoc = Nothing
End If |
Partager