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
94
95
96
97
98
99
100
101
|
'+----------------------------------------------------------------------------------------------------------------------+
'| PROCEDURE PRINCIPALE D'EXPORTATION |
'+----------------------------------------------------------------------------------------------------------------------+
Sub Export_CalendrierCSV()
' dates limites pour la reprise des données
Datedebut = InputBox(" DATE DE DEBUT ? ", _
"date de début", DateAdd("m", -1, Date))
'contrôle de la saisie des dates (bon format et renseignée)
If Not (TestValidDate(Datedebut)) Then
MsgBox "traitement non effectué, date invalide, veuillez recommencer"
Exit Sub
Else
' dateDEB = DateAdd("d", -1, Datedebut)
dateDEB = Datedebut
End If
datefin = InputBox("DATE DE FIN ? ", _
"date de fin", Date)
'contrôle de la saisie des dates (bon format et renseignée)
If Not (TestValidDate(datefin)) Then
MsgBox "traitement non effectué, date invalide, veuillez recommencer"
Exit Sub
Else
dateFN = DateAdd("d", 1, datefin)
End If
'Instance et création du fichier texte
' Messages Box relatifS à la création du fichier dans un emplacement spécifique ou à spécifier
Dim D As Date ' variable date
Dim E1, E2, E3, E4, E5 As String
E2 = "EXPORTATION DU " & Date
Do
E1 = InputBox("Saissez le Nom du Fichier crée," & vbCr & "Par défaut la Racine est : C:\" & vbCr & "Vous pouviez la Modifier" _
& vbCr & "" & vbCr & "NB: Omettez l'extension: Elle est gérée par défaut", E2, "C:\")
If E1 = vbOK Then
ElseIf E1 = "C:\" Or E1 = "" Then 'Message d'erreur
E4 = "le fichier n'a pas été nommé a l'emplacement" & E1
MsgBox (E4)
Else 'Enregistrer la racine
E5 = "Votre fichier a été crée: " & E1
MsgBox (E5)
End If
Loop While E1 = "C:\" Or E1 = "" And E1 = vbCancel
'-------------------------------------------------------------------------------------------------------------------------------+
'parcourir la racine et lire a partir du 4 eme caractère vers la droite |
'-------------------------------------------------------------------------------------------------------------------------------+
' on va compter le nombre de caractere dans la chaine E1 grace a la foction "Len"
'une fois ce nombre connu, on l'insère dans une variable nbrCaract.
'puis cette variable servira de longueur de parcours pour la fonction Right$ avec -3 (la soustration
'nous permet de retirer les trois derniers caracteres de la chaine c-a-d: "C:\" --> notre racine
'Ainsi on obtient le nom de notre TCD: nomTCD
nbrCaract = Len(E1)
nomTCD = Right$(E1, nbrCaract - 3)
'-------------------------------------------------------------------------------------------------------------------------------
Racine = E1 & ".csv"
Racine2 = E1 & ".txt"
Set fsoFichier = objFSO.CreateTextFile(Racine, True)
Set fsoFichier2 = objFSO.CreateTextFile(Racine2, True)
compteur = 1
' - Création des entêtes de colonnes.
strStream = "Evénement sur une journée;Date Début;Heure Début;Date Fin;Heure Fin;Durée;Sujet;Description;Lieu;" & _
"Organisateur;Priorité;Disponibilité;Classification;Catégorie"
'Ecriture dans le fichier de l'entête
fsoFichier.WriteLine (strStream)
fsoFichier2.WriteLine (strStream)
'Instance des objets Outlook
Set objApply = Outlook.Application
Set objNameSpace = objApply.GetNamespace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderCalendar)
Call VerificationDate ' On vérifie ll'Intervalle de date saisie
Call T5 ' On fait appel a la procédure d'ouverture de notre fichier aux format text converti
Call ExcelTCD ' Puis on affiche le TCD de celui-ci !
'Fermeture du fichier
fsoFichier.Close
'Message de fin d'export
MsgBox "Export terminé"
End Sub |
