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
|
' Declaration des variables
Dim ol As Object
Set ol = CreateObject("Outlook.application")
Set m1 = ol.CreateItem(olMailItem)
Dim olns As Object
Dim objFolder As Object
Set olns = ol.GetNamespace("MAPI")
Dim i
Tableau = Array("0301", "0306", "0336", "0403", "0427", "0475", "0605", "0615", "0622", "0642", "0656", "0668H", "0668P", "0695", "0751", "0770", "1608", "1625", "1627", "1673", "1690", "1971")
' Declaration des variables qui vont être saisies par l'utilisateur
periode = InputBox("Mois voulu (AAAA.MM) " & vbCr) '
periode2 = InputBox("Mois voulu (ex: Feb 2010) " & vbCr)
J3 = InputBox("Date J+3 (ex: 3th june) " & vbCr)
' Creation du dossier qui se nommera sous la forme: AAAA.MM ( il s'agit de la variable "periode"
' Si le répertoire éxiste déja, il n'y a pas de creation.
If Not (RepertoireExiste("lien ")) Then
MkDir "lien"
End If
' Enregistrement du fichier dans le dossier du mois.
Workbooks.Open "fichier plat"
ActiveWorkbook.SaveAs Filename:="fichier plat"
ActiveWorkbook.Close
'___________________________________________________________________________________________________________________________
' ouverture du fichier contenant le tableau croisé dynamique
Workbooks.Open "tcd"
For i = LBound(Tableau) To UBound(Tableau)
' choix du code et actualisation
Sheets("Full").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"Code").CurrentPage = Tableau(i)
Sheets("Overview").Select
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotCache.Refresh
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"Code").CurrentPage = Tableau(i)
' enregistrement du fichier dans un dossier précis
ActiveWorkbook.SaveAs Filename:="test" & Tableau(i) & ".xls"
With m1
' Sujet, objet du mail
.Subject = /\ ERREUR au second tour de la boucle /\
.Body =
.To = Tableau(i)
' pièce jointe
.Attachments.Add "fichier excel"
' Sauvegarde du mail dans brouillon (Drafts)
.Save
.Close olPromtForSave
End With
Set ol = Nothing
Set MailSendItem = Nothing
Set olns = Nothing
Next i
ActiveWorkbook.Close |
Partager