flod49 | bonjour a tous,
je cherche une solution à mon problème 
Les conditions:
Je reçois par jour environ 150 mails, dont je souhaite extraire uniquement leurs contenus qui sont:
Sujet :
Acquisition Nø04 aLPHA: 211
De :
SCS <admin@xxxx.com>
Pour :
<contact@xxxxx.com>
Copie à :
<admin@xxxx.com>
Le 14/04/2017 14h27mn38s
C1
H1=10,00mm/s H2=1,28mm/s V=2,65mm/s
C2
H1=7,35mm/s H2=1,37mm/s V=2,65mm/s[/#F0FF00]
En orange sont les données qui changent à chaque réception de mail.
Mon but étant d’insérer de manière auto (VBA sous excel) chaque emails transformés en .txt pour ensuite utiliser la masse importante de donnée et faire des graph et autres
Je souhaite bien evidement changer le format du fichier text et suprimer toutes les lignes et espaces pour en faire qu'une ligne par .txt, comme suit:
14/04/2017;14h29mn38s;C1;H1=12,00mm/s;H2=12,28mm/s;V=22,65mm/s;C2;H1=7,35mm/s;H2=1,37mm/s;V=2,65mm/s;
Problèmes actuels en VBA
Evidemment je débute en VBA, en remerciant pour votre indulgence 
Je n'ai pas trouvé encore la solution pour modifier le contenu du fichier txt d'origine en avec fichier txt avec une seule ligne avec la séparation ";"
Sinon:
1/dans le secteur Private Sub modifier_texte_Click()
j'ai un message d'erreur sur cette ligne Dim fso As FileSystemObject
2/J essaye de supprimer les doublons, seule la colonne "heure" doit être prise en compte et si la condition est validée elle doit pouvoir supprimer toute la ligne.
mon code actuel  :
Code :
- Dim ligne_debut As Integer: Dim colonne_debut As Integer
- Dim ligne_fin As Integer: Dim colonne_fin As Integer
- Dim ligne_enCours As Integer: Dim colonne_enCours As Integer
- Private Sub exporter_Click()
- Dim nom_fichier As String
- ligne_debut = 2: colonne_debut = 2
- ligne_enCours = ligne_debut: colonne_enCours = colonne_debut
- Cells.Clear
- For i = 0 To liste_fichiers.ListCount - 1
- lecture (liste_fichiers.List(i))
- Next i
- Traitement
- nom_fichier = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt),*.txt" )
- sortie.Value = nom_fichier
- ecriture (nom_fichier)
- End Sub
- Private Sub fermer_Click()
- liste_fichiers.Clear
- formulaire.Hide
- End Sub
- Private Sub importer_Click()
- Dim fichier_choisi As String
- fichier_choisi = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Sélectionner le fichier CSV" )
- If (LCase(fichier_choisi) <> "faux" And fichier_choisi <> "0" ) Then
- liste_fichiers.AddItem (fichier_choisi)
- End If
- End Sub
- Private Sub liste_fichiers_Click()
- End Sub
- Private Sub modifier_texte_Click()
- Dim str As String
- Dim fso As FileSystemObject ' AJOUTER LA REFERENCE (VOIR FAQ SI BESOIN)
- Dim fs As Folder
- Dim ts As TextStream
- Dim pathaouvrir As Variant
- Set fso = New FileSystemObject
- ' ouvre le fichier
- Set fs = fso.GetFolder("D:\tintintitn\lalalala\" )
- pathaouvrir = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Sélectionner le fichier CSV" )
- If pathaouvrir <> False Then
- 'vérifions toujours que le fichier existe
- If Dir(pathaouvrir) <> "" Then
- Set ts = fso.OpenTextFile(pathaouvrir)
- ' met tout le contenu dans une variable
- str = ts.ReadAll
- ts.Close
- ' remplace
- str = Replace(str, "C1H1=", "C1;H1 = " )
- ' on écrase
- Set ts = fso.createtextfile(pathaouvrir, True)
- ts.write str
- ts.Close
- End If
- End Sub
- Private Sub sortie_Change()
- End Sub
- Private Sub UserForm_Click()
- End Sub
- Private Sub lecture(Fichier As String)
- Dim depart As Integer, position As Integer
- Dim texte As String, tampon As String
- Open Fichier For Input As #1
- Do While Not EOF(1)
- Line Input #1, texte
- depart = 1: position = 1
- Do While (position <> 0)
- position = InStr(depart, texte, ";", 1)
- If position = 0 Then
- tampon = Mid(texte, depart)
- Sheets("Import" ).Cells(ligne_enCours, colonne_enCours).Value = tampon
- Exit Do
- Else
- tampon = Mid(texte, depart, position - depart)
- End If
-
- Sheets("Import" ).Cells(ligne_enCours, colonne_enCours).Value = tampon
- depart = position + 1
- colonne_enCours = colonne_enCours + 1
-
- Loop
-
- colonne_enCours = colonne_debut
- ligne_enCours = ligne_enCours + 1
-
- Loop
- Close #1
- End Sub
- Private Sub ecriture(Fichier As String)
- Dim ligne As Integer, colonne As Integer
- Dim texte As String
- ligne = ligne_debut: colonne = colonne_debut
- If LCase(Fichier) <> "faux" Then
- Open Fichier For Output As #1
- While Cells(ligne, colonne).Value <> ""
- While Cells(ligne, colonne).Value <> ""
- texte = texte & Cells(ligne, colonne).Value & ";"
-
- colonne = colonne + 1
- Wend
- Print #1, texte
- texte = ""
- colonne = colonne_debut
- ligne = ligne + 1
-
-
- Wend
-
-
- Close #1
- End If
- End Sub
- Sub SupprimeDoublons()
- Dim Plage As Range, Cell As Range
- Dim Un As New Collection
- Dim Tableau() As Integer
- Dim x As Integer
- 'Définit la plage de cellules pour la recherche de doublons
- Set Plage = Worksheets("Import" ).Range("c2:c99999" )
- On Error Resume Next
- 'Boucle sur les cellules de la plage cible
- For Each Cell In Plage
- 'Création d'une collection de données uniques (sans doublons)
- Un.Add Cell, CStr(Cell)
- 'Une erreur survient si l'élément existe dans la collection.
- 'La procédure enregistre le numéro de ligne correspondant dans un tableau.
- If Err.Number <> 0 Then
- x = x + 1
- ReDim Preserve Tableau(1 To x)
- Tableau(x) = Cell.Row
- Err.Clear
- End If
- Next Cell
- On Error GoTo 0
- 'On sort si aucun doublon n'a été trouvé.
- If x = 0 Then Exit Sub
- 'Fige l'écran pendant la suppression des lignes
- Application.ScreenUpdating = False
- 'Boucle sur le tableau pour supprimer les lignes contenant des doublons.
- For x = UBound(Tableau) To LBound(Tableau) Step -1
- Worksheets("Feuil1" ).Rows(Tableau(x)).EntireRow.Delete
- Next x
- Application.ScreenUpdating = True
- End Sub
- Private Sub Traitement()
- Dim ligne As Integer: Dim colonne As Integer
- ligne = ligne_debut: colonne = colonne_debut
- Cells(ligne, colonne).Sort Cells(ligne, colonne), xlAscending, Header:=xlNo
- 'For i = Range("C65536" ).End(xlUp).Row To 2 Step -1
- ' For j = i - 1 To 2 Step -1
- ' If Cells(i, 1) = Cells(j, 1) Then
- ' Rows(i).Delete
- ' End If
- ' Next j
- 'Next i
- ''While Cells(ligne, colonne).Value <> ""
- '' If (Cells(ligne, colonne).Value = Cells(ligne - 1, colonne).Value) Then
- '' Cells(ligne, colonne).EntireRow.Delete
- '' ligne = ligne - 1
- '' End If
- '' ligne = ligne + 1
- ''Wend
-
-
- End Sub
|
Au besoin je peux vous fournir mon fichier xlsm et un fichier .txt brut
En vous remerciant pour votre aide ;-)
flod49
|
