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 |
Partager