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
|
Sub ACTUALISATION_()
Dim Dpc As Document
Dim Reps As Reports, Rep As Report
Dim nbr As Integer, nir As Integer
Dim fso As FileSystemObject
On Error Resume Next
username = Application.Variables.Item("BOUSER").Value 'permet d'initialiser le nom de l'utilisateur ouvrant la session BO
ThisDocument.Variables(1).Value = Format(DateSerial(Year(Date - 1), Month(Date - 1), 1), "dd/mm/yyyy")
ThisDocument.Variables(2).Value = Format(Date, "dd/mm/yyyy")
If Application.Interactive = True Then
Application.Interactive = False
End If
ThisDocument.Refresh
Set Doc = Application.ActiveDocument
Set Reps = Doc.Reports
nbr = Reps.Count
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(ThisDocument.Path & "\" & Format(ThisDocument.Variables(1).Value, "YYYY") & "\") = False Then
fso.createfolder (ThisDocument.Path & "\" & Format(ThisDocument.Variables(1).Value, "YYYY") & "\")
End If
Chemin = ThisDocument.Path & "\" & Format(ThisDocument.Variables(1).Value, "YYYY") & "\"
If fso.FolderExists(Chemin & "\" & Format(ThisDocument.Variables(1).Value, "MMMM") & "\") = False Then
fso.createfolder (Chemin & "\" & Format(ThisDocument.Variables(1).Value, "MMMM") & "\")
End If
Chemin = Chemin & Format(ThisDocument.Variables(1).Value, "MMMM") & "\"
Select Case username
Case "xxxxxx"
CLIENT = "xxxxxxxxx"
For Each Rep In Reps
Rep.Activate
Rep.AddComplexFilter "Eptica Demande BoiteMail(EPTICA_TRAITEMENT)", "=gauche(<Eptica Demande BoiteMail(EPTICA_TRAITEMENT)>, 3) =""MIA"""
Rep.ForceCompute
Next
fichierPDF = ThisDocument.Name & "_MIA_" & CLIENT & "_au_" & Format(ThisDocument.Variables(2).Value, "DD_MM_YYYY") & ".pdf"
Application.ActiveDocument.SaveAs (Chemin & fichierPDF)
objet = "Extraction EPTICA MIA " & CLIENT
message = "Bonjour" & vbCrLf & vbCrLf & "Veuillez trouver ci-joint, l'extraction EPTICA MIA " & CLIENT & " du " & ThisDocument.Variables(1).Value & " au " & ThisDocument.Variables(2).Value & "."
message = message & vbCrLf & vbCrLf & "Vous en souhaitant bonne réception." & vbCrLf & vbCrLf & "Cordialement."
dest = ""
cop = ""
URL = Chemin & fichierPDF
Call COURRIEL(objet, message, dest, cop, URL)
For Each Rep In Reps
Rep.Activate
Rep.AddComplexFilter "Eptica Demande BoiteMail(EPTICA_TRAITEMENT)", "=gauche(<Eptica Demande BoiteMail(EPTICA_TRAITEMENT)>, 3) <>""MIA"""
Rep.ForceCompute
Next
fichierPDF = ThisDocument.Name & "_HORS_MIA_" & CLIENT & "_au_" & Format(ThisDocument.Variables(2).Value, "DD_MM_YYYY") & ".pdf"
Application.ActiveDocument.SaveAs (Chemin & fichierPDF)
objet = "Extraction EPTICA HORS MIA " & CLIENT
message = "Bonjour" & vbCrLf & vbCrLf & "Veuillez trouver ci-joint, l'extraction EPTICA HORS MIA " & CLIENT & " du " & ThisDocument.Variables(1).Value & " au " & ThisDocument.Variables(2).Value & "."
message = message & vbCrLf & vbCrLf & "Vous en souhaitant bonne réception." & vbCrLf & vbCrLf & "Cordialement."
dest = ""
cop = ""
URL = Chemin & fichierPDF
Call COURRIEL(objet, message, dest, cop, URL)
Case "xxxxxxx"
CLIENT = "xxxxxxxx"
For Each Rep In Reps
Rep.Activate
Rep.AddComplexFilter "Eptica Demande BoiteMail(EPTICA_TRAITEMENT)", "=(0=0)"
Rep.ForceCompute
Next
fichierPDF = ThisDocument.Name & "_" & CLIENT & "_au_" & Format(ThisDocument.Variables(2).Value, "DD_MM_YYYY") & ".pdf"
Application.ActiveDocument.SaveAs (Chemin & fichierPDF)
objet = "Extraction EPTICA " & CLIENT
message = "Bonjour" & vbCrLf & vbCrLf & "Veuillez trouver ci-joint, l'extraction EPTICA " & CLIENT & " du " & ThisDocument.Variables(1).Value & " au " & ThisDocument.Variables(2).Value & "."
message = message & vbCrLf & vbCrLf & "Vous en souhaitant bonne réception." & vbCrLf & vbCrLf & "Cordialement."
dest = ""
cop = ""
URL = Chemin & fichierPDF
Call COURRIEL(objet, message, dest, cop, URL)
End Select
'Application.Interactive = True
Application.Quit
End Sub |
Partager