récupération de données de fichiers texte structurés

[ls8]

Bonjour,

Qui aurait des pistes et/ou une amorce de code pour
- récupérer 6-8 rubriques, toujours les mêmes,
- d'un fichier texte structuré issu d'un agenda,
- qui comprend plusieurs centaines d'enregistrements,
- et dont je ne connais pas le nombre au moment de la récupération.

Objectif : obtenir une feuille ou un fichier .csv
avec les noms de champs sur la première ligne
autant de lignes que d'enregistrements à récupérer.

Merci
ls8

========= format de sortie souhaitée ========
OrgConfidential;Subject;StartTime;EndTime;StartDate;EndDate;STARTDATETIME;EndDateTime
1; T. BENXXXXXXXXXX ; 09:00:00; 10:00:00; 27/12/2006; 27/12/2006; 27/12/2006 09:00:00; 27/12/2006 10:00:00
0;J. OLYYYYYYYYY; 10:00:00; 15:00:00; 27/12/2006; 27/12/2006; 27/12/2006 10:00:00; 27/12/2006 15:00:00

======== champs à récupérer =======
OrgConfidential: 1
Subject: T. BENXXXXXXXXXX (point) jusqu'a 256 caractères
StartTime: 09:00:00
EndTime: 10:00:00
StartDate: 27/12/2006
EndDate: 27/12/2006
STARTDATETIME: 27/12/2006 09:00:00
EndDateTime: 27/12/2006 10:00:00


==== Dessin du premier enregistrement ======
$PublicAccess: 1
Body:
Notes:
Chair: CN=Francois-Rene
Principal: CN=Francois-Rene
$AltPrincipal: CN=Francois-Rene
$LangPrincipal:
ExcludeFromView: D,S
SequenceNum: 1
UpdateSeq: 1
$CSVersion: 2
$SMTPKeepNotesItems: 1
$CSWISL: $S:1,$L:1,$B:1,$R:1,$E:1
WebDateTimeInit: 1
OrgTable: C0
STARTDATETIME: 27/12/2006 09:00:00
EndDateTime: 27/12/2006 10:00:00
$Alarm: 1
$AlarmOffset: -30
CalendarDateTime: 27/12/2006 09:00:00
$NoPurge: 27/12/2006 10:00:00
_ViewIcon: 160
$BusyName: CN=Francois-Rene
$BusyPriority: 1
$HFFlags: 1
$ExpandGroups: 3
Logo: StdNotesLtr32
SaveOptions:
MailOptions:
Sign: 0
Encrypt: 0
From: CN=Francois-Rene
$FromPreferredLanguage: fr
ApptUNID: 81C540D9ACE7A9C8xxxxxxxxxxxxxxxx
OnlinePlace:
$LangChair:
AltChair: CN=Francois-Rene
AppointmentType: 0
Alarms: 1
OrgConfidential: 1
Subject: T. BENXXXXXXXXXX (point)
StartTime: 09:00:00
EndTime: 10:00:00
StartTimeZone: Z=-1$DO=1$DL=3 -1 1 10 -1 1$ZX=51$ZN=Romance
EndTimeZone: Z=-1$DO=1$DL=3 -1 1 10 -1 1$ZX=51$ZN=Romance
Repeats:
OrganizerInclude:
Location:
RoomToReserve:
Resources:
OnlineMeeting:
MeetingType: 1
Presenters:
OnlinePlaceToReserve:
AudioVideoFlags:
SendAttachments:
Categories:
SchedulerSwitcher: 1
$BorderColor: D2DCDC
$WatchedItems: $S,$L,$B,$R,$E
BookFreeTime:
StartDate: 27/12/2006
EndDate: 27/12/2006
EnterSendTo:
EnterCopyTo:
EnterBlindCopyTo:
$UpdatedBy: CN=Francois-Rene

 

[Omicron]

Re : récupération de données de fichiers texte structurés

Bonsoir is8,

Faisable à priori, mais un bout de fichier avec quelques enregistrements serait le bien venu ...

Omicron

 

[Luki]

Re : récupération de données de fichiers texte structurés

Bonsoir Is,

As-tu essayé avec: Fichier/ouvrir/ fichier textes, puis en utilisant l'assistant d'Xl?
A+

 

[ODVJ]

Re : récupération de données de fichiers texte structurés

Bonsoir à tous,

une solution à base de formules mises en macro :

Sub Macro1()
'
nbligne = Range("A65536").End(xlUp).Row
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    [B1] = "OrgConfidential:"
    [C1] = "Subject:"
    [D1] = "StartTime:"
    [E1] = "EndTime:"
    [F1] = "StartDate:"
    [G1] = "EndDate:"
    [H1] = "STARTDATETIME:"
    [I1] = "EndDateTime:"
    Range("B2").FormulaR1C1 = _
        "=IF(LEFT(RC1,7)=""$public"",RIGHT(VLOOKUP(R1C&""*"",RC1:R[66]C1,1,FALSE),LEN(VLOOKUP(R1C&""*"",RC1:R[66]C1,1,FALSE))-LEN(R1C)-1),"""")"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:I2"), Type:=xlFillDefault
    Range("B2:I2").Select
    Selection.AutoFill Destination:=Range("B2:I" & nbligne)
    ActiveSheet.Copy
    Range("B2:I" & nbligne).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A1:H1").Select
    Selection.Replace What:=":", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1:h" & nbligne).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
    nbligne_new = Evaluate("=SUMPRODUCT((A1:A" & nbligne & "<>"""")*1)")
    Rows(nbligne_new + 1 & ":" & nbligne).Select
    Selection.Delete Shift:=xlUp
    
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:="H:\fora\toto.csv", FileFormat:=xlCSV, _
        CreateBackup:=False
End Sub

les données sont supposées commencer en A1.

cordialement

 

[ls8]

Re : récupération de données de fichiers texte structurés

Bonsoir,

ODVJ votre solution fonctionne très bien pour les enregistrements simples.
Elle m'a permis de voir quelques questions à résoudre avec les "mémos" et les RV répétitifs.

J'ai compris la démarche, et je vais la suivre pour traiter ces 2 cas.

Merci et bien cordiales salutations
ls8

Bonsoir à tous,

une solution à base de formules mises en macro :

Sub Macro1()
'
nbligne = Range("A65536").End(xlUp).Row
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    [B1] = "OrgConfidential:"
    [C1] = "Subject:"
    [D1] = "StartTime:"
    [E1] = "EndTime:"
    [F1] = "StartDate:"
    [G1] = "EndDate:"
    [H1] = "STARTDATETIME:"
    [I1] = "EndDateTime:"
    Range("B2").FormulaR1C1 = _
        "=IF(LEFT(RC1,7)=""$public"",RIGHT(VLOOKUP(R1C&""*"",RC1:R[66]C1,1,FALSE),LEN(VLOOKUP(R1C&""*"",RC1:R[66]C1,1,FALSE))-LEN(R1C)-1),"""")"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:I2"), Type:=xlFillDefault
    Range("B2:I2").Select
    Selection.AutoFill Destination:=Range("B2:I" & nbligne)
    ActiveSheet.Copy
    Range("B2:I" & nbligne).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A1:H1").Select
    Selection.Replace What:=":", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1:h" & nbligne).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
    nbligne_new = Evaluate("=SUMPRODUCT((A1:A" & nbligne & "<>"""")*1)")
    Rows(nbligne_new + 1 & ":" & nbligne).Select
    Selection.Delete Shift:=xlUp
    
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:="H:\fora\toto.csv", FileFormat:=xlCSV, _
        CreateBackup:=False
End Sub

les données sont supposées commencer en A1.

cordialement