Projet de création d'une liste à partir d'un fichier txt [Résolu]

[pc75]

Re,

Code :

1
2
3
4
5
6
7
8
 
'Pour écrire dans le fichier texte
if categorie = "8" Then 'Valeur à modifier selon catégorie recherchée
With MonFic
.writeLine sID
End with
End If
Monfic.close

[genius2139]

Envoyé par pc75

Re,

Code :

Toujours vide . Et lorsque je met une message box juste après End if, il m'affiche la liste des ID complète.

[pc75]

Re,

Tu veux essayer comme ça ?

Code :

1
2
3
4
5
6
 
'Pour écrire dans le fichier texte
if categorie = "8" Then 'Valeur à modifier selon catégorie recherchée
MonFic.writeLine (sID)
End If
Monfic.close

[genius2139]

Envoyé par pc75

Re,

Tu veux essayer comme ça ?

Code :

Je suis désolé, ça ne marche pas

[pc75]

Re,

Tu peux nous montrer l'intégralité de ton code ?

[genius2139]

Envoyé par pc75

Re,

Tu peux nous montrer l'intégralité de ton code ?

Code :

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
Dim FSO, LeFichier, CheminNomFichier, sFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set FSys = CreateObject("Scripting.FileSystemObject")
Set MonFic = FSys.CreateTextFile("\\monserveur\fichier2.txt")
categorie = Mid(sID, 7, 1)
Const ForReading = 1
CheminNomFichier = "\\monserveur\fichier1.txt"
Set LeFichier = fso.OpenTextFile(CheminNomFichier,ForReading)
sFile = LeFichier.ReadAll
Set oRegEx = New RegExp
' définition du pattern
oRegEx.Pattern = "155 \d{11}"
oRegEx.Global=True
Set Matches = oRegEx.Execute(sFile)
For Each Match in Matches
sID = sID & vbCrLf & Match.Value
sID = Replace(sID, " ",";")
Next
 
'Pour écrire dans le fichier texte
if categorie = "1" Then 'Valeur à modifier selon catégorie recherchée
MonFic.writeLine (sID)
End If
Monfic.close
 
With CreateObject("CDO.Message")
.From="mail@site.fr"
.To="mail@site.frr"
.Subject="ID à utiliser"
.TextBody="Voici les ID :           "
.AddAttachment("\\monserveur\fichier2.txt")
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "serveurmail"
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
On Error Resume Next
.Send
If Err Then MsgBox "Le message n'a pas pu être expédié."
On Error GoTo 0
End With

[pc75]

Re,

Deux choses :

1 - Ta variable categorie est VIDE. A la ligne 5, sID n'existe pas encore.

2 - Si tu mets un msgbox "Boucle for" entre les lignes 15 et 16 tu verras que tu ne rentres pas dans la boucle

[genius2139]

Envoyé par pc75

Re,

Deux choses :

1 - Ta variable categorie est VIDE. A la ligne 5, sID n'existe pas encore.

2 - Si tu mets un msgbox "Boucle for" entre les lignes 15 et 16 tu verras que tu ne rentres pas dans la boucle

Merci de ton intervention. Par contre, J'ai toujours TOUT mes ID. Je n'ai pas mes catégorie 1.

[pc75]

Re,

Comment ça tu as TOUS tes ID ?

Tu veux tester ce bout de code ?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Dim FSO, LeFichier, CheminNomFichier, sFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set FSys = CreateObject("Scripting.FileSystemObject")
Set MonFic = FSys.CreateTextFile("\\monserveur\fichier2.txt")
Const ForReading = 1
CheminNomFichier = "\\monserveur\fichier1.txt"
Set LeFichier = fso.OpenTextFile(CheminNomFichier,ForReading)
sFile = LeFichier.ReadAll
Pos = InStr(sFile, "155")
do while Pos > 0
   categorie = Mid(sFile, Pos + 7, 1)
   if categorie = "4" then
      sID = sId & Replace(mid(sFile, Pos, 15), " ", ";") & "@"
   end if
   sFile = Mid(sFile, Pos + 15)
   Pos = InStr(sFile, "155")
Loop
 
ssID = Split(sId, "@")
For i = 0 to uBound(ssID)
   MonFic.writeLine (ssID(i))
Next
Monfic.close

[Cachlab]

Rebonjour,

Désolé, c'est moi qui t'ai raconté des conneries !
On ne peut pas inclure un test de ligne dans un traitement global ...

Il faut rajouter un process de lecture séquentiel et donc un fichier intermédiaire (FicTmp) :

Code :

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
Const ForReading = 1, ForWriting = 2
Dim FSO, LeFichier, CheminNomFichier, sFile, lect, ecr
Set fso = CreateObject("Scripting.FileSystemObject")
Set MonFic = fso.CreateTextFile("\\monserveur\fichier2.txt")
Set FicTmp = fso.CreateTextFile("\\monserveur\fichiertmp.txt")
CheminNomFichier = "\\monserveur\fichier1.txt"
 
Set LeFichier = fso.OpenTextFile(CheminNomFichier,ForReading)
sFile = LeFichier.ReadAll
Set oRegEx = New RegExp
' définition du pattern
oRegEx.Pattern = "155 \d{11}"
oRegEx.Global=True
Set Matches = oRegEx.Execute(sFile)
For Each Match in Matches
sID = Trim(sID & vbCrLf & Match.Value)
sID = Replace(sID, " ",";")
Next
 
With FicTmp
.writeLine sID
End with
FicTmp.close
MonFic.Close
 
Set lect = fso.OpenTextFile("\\monserveur\fichiertmp.txt", ForReading)
Set ecr = fso.OpenTextFile("\\monserveur\fichier2.txt", ForWriting)
While Not lect.AtEndOfStream
Texte = lect.ReadLine
Texte = Trim(Texte)
categorie = Mid(Texte, 7, 1)
if categorie = "8" Then 'Valeur à modifier selon catégorie recherchée
ecr.Writeline Texte
End if	
Wend
lect.Close
ecr.Close

[genius2139]

On y est presque! Si je met catégorie 3 il m'affiche les catégorie 3 et 1. Si je change la catégorie je met 8 il m'affiche d'autres données du fichier de départ

Il me créé le fichier tmp à côté de mon fichier2. Mon fichier 2 est vide et le fichier tmp affiche tous les ID

A partir du moment que l'on ajoute la fonction "catégorie" le script marche plus. La fonction lister les ID depuis le fichier source marche très bien...

[genius2139]

Je viens d'essayer de mettre mes fichiers en local sur D:\ pour voir si le problème ne venait pas des chemins UNC. C'est pareil.

[Cachlab]

Rebonjour !

Ouaip effectivement ... je me suis perdu dans tes noms de variables (CheminNomFichier, MonFic ...) !
Bon permets moi de redéfinir tes variables pour éviter une nouvelle erreur.

Code :

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
Const ForReading = 1, ForWriting = 2
Dim fso, WShShell, fic_depart, fic_tmp, fic_final, sFile, lect, ecr
Dim Var_depart, Var_tmp, Var_final, Texte, categorie
Set fso = CreateObject("Scripting.FileSystemObject")
Set WSHShell = WScript.CreateObject("WScript.Shell")
fic_depart = "\\monserveur\fichier1.txt"
fic_tmp = "\\monserveur\fichiertmp.txt"
fic_final = "\\monserveur\fichier2.txt"
 
'Saisie de la catégorie recherchée
Rech_cat = InputBox("Catégorie recherchée ?","Saisie")
 
'Lecture du fichier de départ
Set Var_depart = fso.OpenTextFile(fic_depart,ForReading)
sFile = Var_depart.ReadAll
Set oRegEx = New RegExp
oRegEx.Pattern = "155 \d{11}"
oRegEx.Global=True
Set Matches = oRegEx.Execute(sFile)
For Each Match in Matches
sID = sID & vbCrLf & Match.Value
sID = Replace(sID, " ",";")
Next
 
'Ecriture du fichier temporaire
Set Var_tmp = fso.CreateTextFile(fic_tmp)
With Var_tmp
.writeLine sID
End with
Var_depart.close
Var_tmp.close
 
'Lecture du fichier temporaire et écriture du fichier final
Set Var_final = fso.CreateTextFile(Fic_final) : Var_Final.close
Set lect = fso.OpenTextFile(Fic_tmp, ForReading)
Set ecr = fso.OpenTextFile(Fic_final, ForWriting)
While Not lect.AtEndOfStream
Texte = lect.ReadLine
Texte = Trim(Texte)
categorie = Mid(Texte, 7, 1)
if categorie = Rech_cat Then
ecr.Writeline Texte
End if	
Wend
lect.Close
ecr.Close
 
'Affichage du fichier final
if fso.FileExists(fic_tmp) Then fso.DeleteFile Fic_tmp, True 'Efface fichier temporaire
WSHShell.Run ("C:\WINDOWS\system32\notepad.exe " & fic_final) 'Ouvre fichier final avec notepad
WScript.Quit

Ca devrait être mieux comme ça !

[genius2139]

Merci beaucoup. ça marche. Mon fichier résultat est bien le reflet de la catégorie que je spécifie dans la message box!! Par contre, si je veux lui spécifier plusieurs catégories?

[Cachlab]

Heu ... copier/coller ?
(Saisir 38 ou 83, pour cat.3 et cat.8).

Code :

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
Const ForReading = 1, ForWriting = 2
Dim fso, WShShell, fic_depart, fic_tmp, fic_final, sFile, lect, ecr
Dim Var_depart, Var_tmp, Var_final, Texte, categorie
Set fso = CreateObject("Scripting.FileSystemObject")
Set WSHShell = WScript.CreateObject("WScript.Shell")
fic_depart = "\\serveur\fichier1.txt"
fic_tmp = "\\serveur\fichiertmp.txt"
fic_final = "\\serveur\fichier2.txt"
 
'Saisie de la (les) catégorie(s) recherchée(s) 
Rech_cat = InputBox("Catégorie recherchée ?","Saisie")
Long_cat = Len(Rech_Cat)
 
'Lecture du fichier de départ
Set Var_depart = fso.OpenTextFile(fic_depart,ForReading)
sFile = Var_depart.ReadAll
Set oRegEx = New RegExp
oRegEx.Pattern = "155 \d{11}"
oRegEx.Global=True
Set Matches = oRegEx.Execute(sFile)
For Each Match in Matches
sID = sID & vbCrLf & Match.Value
sID = Replace(sID, " ",";")
Next
 
'Ecriture du fichier temporaire
Set Var_tmp = fso.CreateTextFile(fic_tmp)
With Var_tmp
.writeLine sID
End with
Var_depart.close
Var_tmp.close
 
'Lecture du fichier temporaire et écriture du fichier final
Set Var_final = fso.CreateTextFile(Fic_final) : Var_Final.close
Set lect = fso.OpenTextFile(Fic_tmp, ForReading)
Set ecr = fso.OpenTextFile(Fic_final, ForWriting)
While Not lect.AtEndOfStream
Texte = lect.ReadLine
Texte = Trim(Texte)
categorie = Mid(Texte, 7, 1)
For i = 1 to Long_Cat
if categorie = Mid(Rech_cat, i, 1) Then
ecr.Writeline Texte
End if	
Next
Wend
lect.Close
ecr.Close
 
'Affichage du fichier final
if fso.FileExists(fic_tmp) Then fso.DeleteFile Fic_tmp, True
WSHShell.Run ("C:\WINDOWS\system32\notepad.exe " & fic_final)
WScript.Quit

[genius2139]

ça marche!
Merci beaucoup Cachlab. Maintenant que mon fichier final est terminé, je vais l'envoyé par mail tous les jours avec différents ID. Je souhaiterais trouver une fonction envoie par mail uniquement si le fichier final n'est pas vide. Si le fichier est vide à l’exécution du script, donc pas d'ID pour le jour, je devrais avoir comme message "Pas d'ID ce jour". Aussi, ce qui serait intéressant c'est d'avoir dans l'objet du mail "Bilan des ID + [date du jour]

[omen999]

une fonction envoie par mail uniquement si le fichier final n'est pas vide

Si le fichier est vide à l’exécution du script, donc pas d'ID pour le jour, je devrais avoir comme message "Pas d'ID ce jour"

donc le fichier n'est jamais vide...
une recherche google sur le forum (champ tout en haut à droite de la page) te donnera plein d'exemples d'envoi de mail en vbs
à moins qu'une âme charitable et désoeuvrée t'aligne les lignes de code adéquates

[genius2139]

J'ai déjà la fonction mail mais je ne sais pas comment lui dire d'envoyer uniquement si le fichier final à des ID. Et mettre en objet la date du jour.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'Envoi par mail
With CreateObject("CDO.Message")
.From="mail@test.fr"
.To="dest@test.fr"
.Subject="Les ID du jour"
.TextBody="Voici les numéros ID"& vbLf& vbLf
.AddAttachment("\\serveur\fichier2.txt")
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mailserver"
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
On Error Resume Next
.Send
On Error GoTo 0
End With

[Cachlab]

Salut !

J'étais en train de matter le Script l'Histoire sans Fin !

En testant que la valeur 'oFl.Size' du fichier final est non-nulle, tu devrais pouvoir déterminer si le fichier est vide ou non.
Je pense que ce lien pourra t'orienter :
http://vb.developpez.com/faqvbs/?pag...fsoInfoFichier

Et pour récupérer la date du jour :
http://vb.developpez.com/faqvbs/?page=II.8#vbsNow

J'espère que ça t'aidera.
++

[genius2139]

Pour la fonction "size" voici mon code mais ça ne marche pas

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
'Condition d'envoi du mail
Set oFSO = CreateObject("Scripting.FileSystemObject")
stFichier = "\\serveur\fichier2.txt"
Set oFl = oFSO.GetFile(stFichier)
If oFl.Size = 0 then
'Envoi par mail
With CreateObject("CDO.Message")
.From="mail@test.fr"
.To="dest@test.fr"
.Subject="Les ID du jour"
.TextBody="Voici les numéros ID"& vbLf& vbLf
.AddAttachment("\\serveur\fichier2.txt")
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mailserver"
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
On Error Resume Next
.Send
On Error GoTo 0
End With
End If