VBS recuperation de colonnes plus formatage de certaines

Version imprimable

Bonjour je voulais faire un scipt VBS me permettant de recupérer le dernier fichier généré ayant "Active_Profile" dans le nom et récupérer uniquement les colonnes (4,1,2,3.....) pour créer un nouveau fichier, le script ne fonctionne pas merci pour votre aide

Idéalement j'aimerai pouvoir formater certaines colonnes :
2 , 8 sur 8 caractere "00000000"
13 étant une date j'aimerai pouvoir rajouter au fichier créér une colonne "YYYY-MM"

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
55
56
57
58
59
Option Explicit
 
Dim fso, folder, files, file
Dim folderPath, latestFile, latestDate
Dim inputFile, line, fields, output
Dim colOrder, i
 
' --- Personnalise ce chemin ---
folderPath = "C:\TEMP\FILES\IMPORT\PROFIL"  ' <-- Met le bon chemin ici
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
Set files = folder.Files
 
Set latestFile = Nothing
latestDate = #1/1/1900#
 
' Trouver le fichier le plus récent contenant "_Profile_Users_Global_Active"
For Each file In files
    If InStr(file.Name, "_Profile_Users_Global_Active") > 0 Then
        If file.DateLastModified > latestDate Then
            Set latestFile = file
            latestDate = file.DateLastModified
        End If
    End If
Next
 
If latestFile Is Nothing Then
    MsgBox "Aucun fichier contenant '_Profile_Users_Global_Active' trouvé.", vbExclamation
    WScript.Quit
End If
 
' Colonnes à extraire (base 1)
colOrder = Array(4, 1, 2, 3, 15, 9, 8, 10, 11,7)
 
' Lire le fichier et extraire les colonnes
Set inputFile = fso.OpenTextFile(latestFile.Path, 1, False)
output = "Fichier : " & "LAST_ACTIVE_PROFILE.csv" & vbCrLf & vbCrLf
 
Do Until inputFile.AtEndOfStream
    line = inputFile.ReadLine
    fields = Split(line, ";") ' change ";" en "," si ton fichier utilise des virgules
 
    If UBound(fields) >= 14 Then ' Vérifie qu'il y a au moins 15 colonnes (base 0)
        For i = 0 To UBound(colOrder)
            If colOrder(i) - 1 <= UBound(fields) Then
                output = output & fields(colOrder(i) - 1) & vbTab
            Else
                output = output & "?" & vbTab
            End If
        Next
        output = output & vbCrLf
    End If
Loop
 
inputFile.Close
 
' Affiche les résultats
MsgBox output

04/06/2025, 19h40
umfred

Quand tu dis "ça ne fonctionne pas" ça veut dire quoi exactement ?
Tu arrives à trouver ton fichier le plus récent ou pas ? (fait un affichage aussi si tu as une valeur de latestdate, en affichant cette date et le nom du fichier en question)
Tu n'arrives pas à traiter les données ? (c'est quoi comme type de fichier pour commencer ? un csv a priori)
Quel est le résultat obtenu ?
Pour appliquer un formatage spécifique je ferais un Select Case i dans la ligne 47, et traiterai les valeurs 1 (Case 1)(et je formerai ma date avec la colonne 1 et 3, donc le 3 ne serait plus une colonne à traiter), 2 et 8 (Case 2,8:) en appliquant ton formatage, et en Case Else les autres colonnes sans formatage spécifique
05/06/2025, 09h50
laurent27530

J'obtiens pas de resultat le script se deroule et rien, je sais pas si il fonctionne ou bloc a un endroit
Vu que j'ai mis un message au cas il ne trouvent pas les ficihers concerné je pense qu'il les trouvent mais apres ????
05/06/2025, 10h37
laurent27530

Bonjour

Le nouveau ficiher ne se cree pas.et je ne vois pas comment traiter les modiciations que je veux apporter.

exemple
j'ai une colonne qui contient id_users

ajouter le colonne Id_user_std
Si Id_user est numerique
then Id_user_std= format(id_user,"00000000")
else Id_user_std=Id_user

et que cette colonne reste au format texte apres l'ouverture dans excel

J'ai une colonne date
je voudrais ajouter une colonne mois
Date= format(Date,"YYYY-MM")

Mon ficihier faisant plus 27000 lignes par les macro VBA le traitement est tres long mon but est de traiter lemaximun de point avant le traitement excel.

Je ne suis pas sûr qu'il y ai un avantage à le faire en VBS plutôt qu'en macro VBA.
Pour que le format reste textuel pour ton id, le plus simple je pense serait de mettre a minima un guillemet simple en début de chaine (parce qu'Excel risque de transformer automatiquement en nombre cet Id) (au "pire", entourer l'Id de guillemets double)

Le fichier ne se créé pas car tu n'as pas de code qui le créé dans le code que tu nous as montré, il y a juste celui de la lecture.
En revanche, tu affiches le résultat dans un MsgBox (qui de mémoire (mais je peux me tromper) est limité en taille de chaine affichée, et avec un fichier de 27000, je pense qu'il va être saturé)
Donc si il se passe quelque chose, tu devrais avoir un MsgBox qui apparait avec le résultat effectué.

En lançant ton script depuis une invite de commande (et pas en faisant juste un clic dessus), tu devrais voir si ça te retourne des messages d'erreurs aussi.

J'ai repris ton code initial pour essayer d'y ajouter ton besoin (il y a des valeurs à changer, dont le chemin de sortie); je ne pense avoir fait trop d'erreur (:mrgreen: )

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
 
Dim fso, folder, files, file
Dim folderPath, latestFile, latestDate
Dim inputFile, line, fields, output, outputFile
Dim colOrder, i
 
' --- Personnalise ce chemin ---
folderPath = "C:\TEMP\FILES\IMPORT\PROFIL"  ' <-- Met le bon chemin ici
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
Set files = folder.Files
 
Set latestFile = Nothing
latestDate = #1/1/1900#
 
' Trouver le fichier le plus récent contenant "_Profile_Users_Global_Active"
For Each file In files
    If InStr(file.Name, "_Profile_Users_Global_Active") > 0 Then
        If file.DateLastModified > latestDate Then
            Set latestFile = file
            latestDate = file.DateLastModified
        End If
    End If
Next
 
If latestFile Is Nothing Then
    MsgBox "Aucun fichier contenant '_Profile_Users_Global_Active' trouvé.", vbExclamation
    WScript.Quit
Else
    MsgBox "Fichier plus récent trouvé: " & latestfile.Name "on sait ainsi quel est le fichier le plus récent trouvé
End If
 
' Colonnes à extraire (base 1)
colOrder = Array(4, 1, 2, 15, 9, 8, 10, 11,7)
 
' Lire le fichier et extraire les colonnes
Set inputFile = fso.OpenTextFile(latestFile.Path, 1, False)
output = "Fichier : " & "LAST_ACTIVE_PROFILE.csv" & vbCrLf & vbCrLf
Set outputFile = fso.OpenTextFile("chemin\du\fichier\resultat.csv",0,True) ' <=== A modifier selon l'emplacement du fichier résultat voulu et si on veut le créer ou si on veut ajouter des lignes si existant (passer 0 à 2)
outputFile.write(output) '<== on écrit la 1ère ligne 
 
Do Until inputFile.AtEndOfStream
    line = inputFile.ReadLine
    fields = Split(line, ";") ' change ";" en "," si ton fichier utilise des virgules
    output ="" '<== on initialise la ligne écrire
    If UBound(fields) >= 14 Then ' Vérifie qu'il y a au moins 15 colonnes (base 0)
        For i = 0 To UBound(colOrder)
            If colOrder(i) - 1 <= UBound(fields) Then
                Select Case i
                    Case 1
                         output= ouput & fields(colOrder(i)-1) & "-" & fields(colOrder(i)+2-1) & vbTab '<== on peut simplifier en mettant directement les indices des colonnes (je suppose que colonne 1 c'est l'année et colonne 3 le mois (les deux dans le bon format voulu à la fin)
                    Case 2,8 '<== je suppose que c'est sur l'une de ces colonnes que tu as ton identifiant 
                         Dim t
                         t=fields(colOrder(i)-1)
                         If isNumeric(t) Then
                             output= output & Format(t,"00000000") & vbTab
                         Else
                             output = output & t & vbTab
                         End If
                    Case Else
                         output = output & fields(colOrder(i) - 1) & vbTab
               End Select
            Else
                output = output & "?" & vbTab
            End If
        Next
        output = output & vbCrLf
    End If
    outputFile.write(output)
Loop
outputFile.close '<== on ferme le fichier de sortie
inputFile.Close
 
' Affiche les résultats
'MsgBox output '<= devenu inutile, mais on peut la déplacer avant Loop pour vérifier la ligne écrite

18/06/2025, 10h27
laurent27530

1 pièce(s) jointe(s)

J'ai une erreur en ligne 41

Code:

Set outputFile = fso.OpenTextFile("chemin\du\fichier\resultat.csv",0,True) ' <=== A modifier selon l'emplacement du fichier résultat voulu et si on veut le créer ou si on veut ajouter des lignes si existant (passer 0 à 2)

Pièce jointe 668171

J'ai modifié dans mon script le chemin.

Avez vous une idée ?
18/06/2025, 13h56
ProgElecT

Salut

le 2ém paramètre de fso.OpenTextFile ne peut prendre comme valeur que 1, 2 ou 8.

1 ForReading ==> Ouvrir un fichier uniquement pour la lecture. Vous ne pouvez pas écrire dans ce fichier.
2 ForWriting ==> Ouvrir un fichier pour l’écriture.
8 ForAppending ==> Ouvrir un fichier et écrire à la fin du fichier.
18/06/2025, 15h35
laurent27530
J'ai identifié 2 anomalies

Le premier est que le séparateur dans le fichier créer n'est plus le ";" mais tabulation.

Autres souci il semble que les dates soient formatées "08-JAN-2001" il faudrait que je puisse récupérer les dates au format "08/01/2001"
enfin de compte il faudrait remplacer "-JAN- par "/01/" "-FEB-" par "/02/".....

Je pense meme que cette etape doit etre en amont du tratement du dessous
Code:

1 2 Case 1 output = output & fields(colOrder(i)-1) & "/" & fields(colOrder(i)+2-1) & vbTab
18/06/2025, 16h43
umfred

Normal avec vbTab entre les champs (j'ai repris ton code sur ce point) donc si tu veux des virgules, remplace ces vbTab par ","

(oups pour le 2nd paramètres, mes yeux ont mal vu le 8 :mrgreen: )
18/06/2025, 17h47
laurent27530

comment remplacer une partie des dates pour pouvoir par la suite faire la colonone "YYYY-MM"

"-JANV-" => "/01/"
"-FEB-" => "/02/"
"-MAR-" => "/03/"
"-APR-" => "/04/"
.............

Code:

output = output & replace(replace(replace(replace(fields,"-JANV-","/01/"),"-FEB-","/02/"),"-MAR-","/03/"),"-APR-","/04/")& ";"

Je verrais plutôt quelque chose à base d'un tableau ou assimilé contenant les mois dans l'ordre, et on remplace par l'indice dans le tableau (à +1 près), formaté sur 2 caractères.
et remplacement systématique des "-" par des "/"
un truc du genre (non testé)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 'Retourne le numéro du mois si trouvé, sinon renvoie 0 Function GetMonthNumber(MonthName as String) as Integer Dim ListeMois Dim i as Integer ListeMois =Array("JANV","FEB","MAR","APR","MAI","JUN","JUL","AUG","SEPT","OCT","NOV","DEC") 'à modifier avec les vrais noms que tu as For i = 0 to ubound(ListeMois) If ListeMois=UCase(MonthName) Then GetMonthNumber=i+1 Exit For End If Next i End Function
PS: Je trouve étonnant d'avoir un nommage "français" pour Janvier (=>JANVier) et un nommage "anglais" pour Février (=>FEBruary), Avril (=> APRil)

ailleurs dans le code, quelque chose comme ça (si je reprends le code que j'avais fait)
Code:

1 2 3 4 ... Case 1 output= ouput & fields(colOrder(i)-1) & "-" & Format(GetMonthNumber(fields(colOrder(i)+2-1)),"00") & "," '<== toujours en supposant que colonne 1 c'est l'année et colonne 3 le mois ...