Convertisseur txt / ics - csv / ics

Télécharger le projet
Commenter

Description

Ce petit code Excel sans prétention est tellement affligeant que je n'osais pas le diffuser. Il date de 2007 et à la demande d'un collègue intéressé je vous le jette.
Utilisant le logiciel Rainlendar V2.5 à mon boulot, je voulais récupérer les données du calendrier de mon PALM pour les déverser dans Rainlendar. Travaillant sur des PC hyper verrouillés, je n'ai pas la possibilité d'installer PALM desktop, ni les conduites PALM pour Rainlendar. Je récupère donc le calendrier du PALM chez-moi, en format "dba", puis je le convertis en format "txt" avec le logiciel "DBA2CSV". Avec mon fichier "txt", il me suffit de le mouliner à l'aide de mon applis Excel pour obtenir un fichier "ICS", directement importable dans Rainlendar (ouf !!!). Il y a surement plus simple, ou plus technique, ou plus compliqué, mais là, ca fonctionne et ca me suffit.
J'y ai intégré la superbe "Progressbar" de Cybercraft2003. Un grand merci à lui !!!!!
Le code est commenté et le fichier Excel est directement utilisable. Lisez les annotations et autres infos. Le fichier "txt" se nomme Agenda.txt, vous pouvez renommer la requête dans la feuille "Agenda" en cliquant bouton droite sur la première ligne, puis "Modifier l'importation du Texte". Choisissez votre fichier.
Le nom du fichier de sortie est à configurer dans la feuille ICS. (en cellule F3)

Source / Exemple : 


' Code écrit en 07/2007 (ça date un peu)
' 10/11/2009 Intégration de la ProgressBar de Cybercraft2003 !! Merci à lui !!
' 13/09/2010 Conversion directe à partir des fichiers CSV.
' 13/09/2010 Prise en compte des evenements consécutifs - Même libellé, même Loc, date consécutive.

Public SUMMARY, Cat

Sub Convertion()
Dim MEMDAT, CHECK, DTSTART, DTSTART1, DTSTART2, DTEND, DTEND1, Heure_D, Heure_F, DECRIPT, LOC, LOC1, LOC2, NB_Don, L_I1, L_I2, L_Dep, NB_Exp, DTSTAMP, ICS(65536), Namfich
Dim PctDone As Single
Sheets(1).Select
L_Dep = 5                               ' Ligne de départ Exportation
NB_Exp = 8                              ' Nb de données à Exporter pour chaque evenement
NB_Don = Sheets(1).Range("O3")    ' Nb de données totales dans le tableau
DTSTAMP = Sheets(1).Range("O7")   ' Assemblage de la valeur DATE & HEURE
Application.ScreenUpdating = False      ' Bloque le rafraichissement de l'affichage
' Importation des données et comparaison des dates & libelles.
For i = 1 To NB_Don                      ' Compte de 1 à NB de Données
L_I1 = i + 2                             ' Ligne de départ importation ligne 1
L_I2 = i + 3                             ' Ligne de départ importation ligne 2
MEMDAT = Range("M" & L_I1)               ' Mem date début
DTSTART1 = Range("B" & L_I1)             ' Date de Début ligne 1
DTEND1 = Range("K" & L_I1)               ' Date de fin ligne 1
DTSTART2 = Range("B" & L_I2)             ' Date de Début ligne 2
Heure_D = "T" & Range("J" & L_I1)        ' Heure de début
Heure_F = "T" & Range("L" & L_I1)        ' Heure de fin
SUMMARY = Range("A" & L_I1)              ' Evenement ligne 1
CHECK = Range("A" & L_I2)                ' Evenement ligne 2
DESCRIPT = Range("F" & L_I1)             ' Description de l'evenement
LOC1 = Range("G" & L_I1)                 ' Localisation ligne 1
LOC2 = Range("G" & L_I2)                 ' Localisation ligne 2
' Compare les dates de début et de fin
If SUMMARY = CHECK And LOC1 = LOC2 And DTSTART2 = DTSTART1 + 1 Then GoTo 300 Else
DTSTART = MEMDAT
DTEND = DTEND1
LOC = LOC1
' Lance la Function CATEGORIES
Cats
' Exportation des données et mise au Format ICS !!
Sheets(2).Range("A" & L_Dep).FormulaR1C1 = "BEGIN:VEVENT"
If Heure_D = "T" Then Sheets(2).Range("A" & L_Dep + 1).FormulaR1C1 = "DTSTART;VALUE=DATE:" & DTSTART Else Sheets(2).Range("A" & L_Dep + 1).FormulaR1C1 = "DTSTART:" & DTSTART & Heure_D
If Heure_D = "T" Then Sheets(2).Range("A" & L_Dep + 2).FormulaR1C1 = "DTEND;VALUE=DATE:" & DTEND Else Sheets(2).Range("A" & L_Dep + 2).FormulaR1C1 = "DTEND:" & DTEND & Heure_F
Sheets(2).Range("A" & L_Dep + 3).FormulaR1C1 = "CATEGORIES:" & Cat
Sheets(2).Range("A" & L_Dep + 4).FormulaR1C1 = "DESCRIPTION:" & DESCRIPT
Sheets(2).Range("A" & L_Dep + 5).FormulaR1C1 = "SUMMARY:" & SUMMARY
Sheets(2).Range("A" & L_Dep + 6).FormulaR1C1 = "LOCATION:" & LOC
Sheets(2).Range("A" & L_Dep + 7).FormulaR1C1 = "END:VEVENT"
L_Dep = L_Dep + NB_Exp      ' Ligne Exportation Evenement suivant
300 ' affiche la barre et relance la boucle
PctDone = i / NB_Don
UpdateProgressBar PctDone
Next i                      ' Evenement suivant
' Cloture du fichier ICS
Sheets(2).Range("A" & L_Dep).FormulaR1C1 = "END:VCALENDAR"
500 ' Exporte le Fichier ICS
Sheets(2).Activate
Namfich = Range("F3")
fff = Range("C2")
Open ThisWorkbook.Path & "\" & Namfich For Output As #1  'Ouvre/genere le fichier 'Chris.ics'
For z = 1 To fff
ICS(z) = Range("A" & z)
    Print #1, ICS(z)
Next z
Close #1
ProgressBar.Hide
'Fermeture du fichier et fin
toto = MsgBox("Données Exportées !!!", vbOKOnly, "Exportation terminée")
Application.ScreenUpdating = True       'Debloque le rafraichissemnet de l'affichage
End Sub

Sub UpdateProgressBar(PctDone As Single)    'Code de la sous-routine
    With ProgressBar
        .FrameProgress.Caption = Format(PctDone, "0%")        ' Mise à jour du label.
' Afin de paramétrer la fin de la progressBar par rapport au frame
        .LabelProgress.Width = PctDone * _
            (.FrameProgress.Width - 10)
    End With
    ' DoEvents autorisant au UserForm de ce mettre à jour
    DoEvents
End Sub

Sub Lance_Export()
ProgressBar.Show
End Sub

Private Function Replace()
Dim Rec, Rep                    'Remplacement des caractères spéciaux suivant tableau M12:N17
zzz = Range("N18")
For s = 1 To zzz
Rec = Range("N" & 11 + s)
Rep = Range("O" & 11 + s)
    Columns("A:H").Select
    Selection.Replace What:=Rec, Replacement:=Rep, LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=True
Next s
Range("A3").Select
End Function

Private Function Cats()
' SSS prend les 3 premiers caractères de SUMMARY
Cat = ""
SSS = Left(SUMMARY, 3)
Select Case SSS     'Suivant 'SSS' attribut la catégorie correspondante
Case "Ast"
    Cat = "Work"
Case "F3F"
    Cat = "Trip"
Case "RTT"
    Cat = "Vacation"
Case "Ann"
    Cat = "Anniversary"
Case "Vac"
    Cat = "Vacation"
Case "RdV"
    Cat = "Medical"
Case "Muz"
    Cat = ""
Case "Ale"
    Cat = ""
Case "F3A"
    Cat = "Trip"
Case "St "
    Cat = "Health"
Case "Fér"
    Cat = "Personal"
Case "Vol"
    Cat = "Trip"
Case "RC "
    Cat = "Vacation"
Case "CA "
    Cat = "Vacation"
End Select
End Function

Conclusion :


Un petit code qui fait ce qu'on lui dit de faire et ca suffit. S'il peut servir à quelqu'un, tant mieux ...
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_GTI38)