Forum du club des d�veloppeurs et IT Pro - VBScript

Utiliser une boite dialog pour choix dossier et fichier Win 11 - 64bits

cincap — Mon, 26 Jan 2026 11:44:48 GMT

Bonjour � toutes et � tous,

Avec mon Fichier .vbs j'aimerai avec une boite de dialog pouvoir choisir mon dossier et mon fichier plut�t que de les fixer par d�faut.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
' Définir le chemin du dossier et le nom du fichier
Dim dossierParent, nomFichier
dossierParent = "C:\Test\"
nomFichier = "Test1.jpg"
 
' Créer l'objet Shell
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(dossierParent)
Set objFile = objFolder.ParseName(nomFichier)
 
WScript.Echo "Fichier : " & objFolder.GetDetailsOf(objFile, 0)
WScript.Echo "Date prise : " & objFolder.GetDetailsOf(objFile, 161)
WScript.Echo "Appareil : " & objFolder.GetDetailsOf(objFile, 175)

J'ai ce code mais malgr� mes essais d'adaptation je n'y arrive pas.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Dim objShell, objFolder, strFileName
Set objShell = CreateObject("Shell.Application")
' Ouvre la boîte de dialogue de sélection de fichier
Set objFolder = objShell.BrowseForFolder(0, "Sélectionnez un fichier :", &H4000)
 
If Not objFolder Is Nothing Then
    strFileName = objFolder.Self.Path
    MsgBox "Vous avez sélectionné : " & strFileName
Else
    MsgBox "Aucun fichier sélectionné."
End If
 
Set objFolder = Nothing
Set objShell = Nothing

@+,

cincap

Cr�er un fichier texte pour informations Windows 11

cincap — Thu, 22 Jan 2026 08:56:58 GMT

Bonjour � toutes et � tous,

Avec mon fichier .vbs qui fonctionne, j'aimerai pouvoir aussi lire les informations depuis un fichier texte qui sera cr�� en parall�le.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
' Définir le chemin du dossier et le nom du fichier
Dim dossierParent, nomFichier
dossierParent = "C:\Test\"
nomFichier = "Test1.jpg"
 
' Créer l'objet Shell
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(dossierParent)
Set objFile = objFolder.ParseName(nomFichier)
 
WScript.Echo "Fichier : " & objFolder.GetDetailsOf(objFile, 0)
WScript.Echo "Date prise : " & objFolder.GetDetailsOf(objFile, 161)
WScript.Echo "Appareil : " & objFolder.GetDetailsOf(objFile, 175)

Merci d'avance,

@+,

cincap

Probl�me de casse des nom de fichiers d'une collection de fichiers

Ale14 — Fri, 02 Jan 2026 23:42:08 GMT

Bonjour,

J'ai un script en VBS qui a pour but de d�placer les fichiers dans des r�pertoires diff�rents en fonction d'une partir de leur nom.
EX : si le nom de fichier contient "Facture" il est d�plac� dans le fichier Facture, si le nom contient URSSAF il est d�plac� dans le r�pertoire des cotisations.

Le script fonctionnait correctement en respectant la casse des noms fichiers, mais depuis quelques mois tous les noms de fichiers des collections (colfiles dans le script) sont syst�matiquement en minuscule et sans que je change une seule ligne � mon script. Or j'ai besoin que ces fichiers gardent leur casse d'origine.
Quelqu'un aurait-il une id�e ? une Solution SVP ?
Merci d'avance.
Antoine

Je vous joins mon script

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
 
Option Explicit
'/////////////////////////// CONSTANTES //////////////////////
 
'Répertoire pour fichiers
Const LECTEUR_C = "C:"
Const LECTEUR_D = "D:"
Const REP_FACTURES = "M:\Cabinet\Comptabilité\2025\01-Factures\"
Const REP_COTIS = "M:\Cabinet\Comptabilité\2025\02-Cotisations-charges\"
Const REP_TELECHARGT = "C:\Users\antoi\Downloads\"
'Const REP_TRACES = "M:\Cabinet\"
 
'Chemins pour requêtes
'Const REP_REQ_SCAN ="'\\Cabinet\\_SCANS\\'"
Const REP_REQ_SCAN ="'\\Cabinet\\_SCANS\\TEST\\'"
Const REP_REQ_TELECHARGT ="'\\Users\\antoi\\Downloads\\'"
Const REP_REQ_PRO ="'\\Users\\antoi\\Downloads\\Professionnel\\'"
'Const REP_FACTURES = "M:\Cabinet\Comptabilit" & chr(233) & "\"
'Dim REP_FACTURES
'REP_FACTURES = "M:\Cabinet\Comptabilit" & chr(233) & "\"
 
'/////////////////////////// VARIABLES ///////////////////////
Dim fsot
Dim fichierLog
Dim Test
 
Dim Shell
Dim oShell
Dim env
Dim objWMIService
Dim colFiles
Dim strComputer
Dim objFile
Dim requete
 
Dim chemin
Dim repScan
Dim repTelechargement
Dim repPro
Dim repCopie
Dim repCible
 
Dim errOpeFile
'FIN DECLARATION DES VARIABLES
 
 
'/////////////////////////// PROCEDURES ///////////////////////////////////////
'******************************************
' Procédure d'ouverture du fichier de logs
'******************************************
Sub OuvertureLog ()
 
	Dim repLog
	Dim nomFichierLog
	Dim monLog
 
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
 
	Set fsot = WScript.CreateObject("Scripting.FileSystemObject")
 
	'repLog = REP_TRACES
	repLog = REP_TELECHARGT
	nomFichierLog = "Log_Fichiers_EC.log"
 
	MsgBox repLog & nomFichierLog
	Set fichierLog = fsot.OpenTextFile(repLog & nomFichierLog, ForAppending, TristateTrue)
 
	'monLog = Now & " - " & "Ouverture du fichier traces"
	'fichierLog.WriteLine(monLog)
 
End sub
 
'******************************************
' Procédure d'écriture de log
'******************************************
Sub TracesLog (messageTrace)
 
	Dim monLog
 
	monLog = Now & " - " & messageTrace
	fichierLog.WriteLine(monLog)
 
End Sub
 
 
'******************************************
' Procédure de dépalcement de fichiers
'******************************************
Sub DeplacerFichiers(collFichiers, repCible, Test)
 
Dim Proc
Proc = "DeplacerFichiers"
 
 
On Error Resume Next
Err.Clear
 
	For Each objFile in collFichiers
		'Wscript.Echo "Dossier => " & objFile.Drive & objFile.Path
		'Wscript.Echo "Taille  =>x " & objFile.FileSize & " Octets"
		'Wscript.Echo "Nom     => " & objFile.FileName & "." & objFile.Extension
 
		TracesLog(Proc & " >>> Ficher : " & objFile.FileName & "." & objFile.Extension)
		repCopie = repCible &  objFile.FileName & "." & objFile.Extension
		TracesLog(Proc & "Rep destination => " & repCopie)
 
		If Test = False Then
			errOpeFile = objFile.copy(repCopie, True)
			TracesLog(Proc & "errOpeFile => " & errOpeFile)
			if errOpeFile = 0 then
				objFile.delete
				TracesLog(Proc & "Suppression du fichier")
			Else
				TracesLog(Proc & "Erreur n° : " & Err.Number & " - " & Err.Description)
			End if
		Else
 
		End if
	Next
 
End Sub
'/////////////////////////// FONCTIONS ////////////////////////////////////////
 
 
'******************************************************************************
' *** DEBUT DU SCRIPT ***
'******************************************************************************
 
'*** Configuration des variables d'environnement
OuvertureLog()
TracesLog(" ///// DEMARRAGE DU SCRIPT ///// ")
 
Set Shell = CreateObject("wscript.Shell")
Set env = Shell.environment("Process")
strComputer = env.Item("Computername")
 
'\root\cimv2 = namespace (BDD logique) contenant des groupes de classes
'WQL = langage d'interrogation de type SQL modifié ; interroge des classes et renvoie des classes
set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
 
 
'FICHIERS LOYER, URSSAF
'****************************
TracesLog("DEBUT TRAITEMENT FICHERS LOYER, URSSAF")
repScan = REP_REQ_SCAN
requete = "Select * from CIM_DataFile Where Drive = 'D:' and Path = " & repScan & "and (FileName like '%SGA Loyer%' OR FileName like '%URSSAF%')"
TracesLog("Requête : " & requete)
set colFiles = objWMIService.ExecQuery (requete)
 
'Traitement en lien avec l'encodage et les accents le script est en UTF8 et window en windows 1250 (chr(233) = "é"
chemin = Replace(REP_COTIS,"é",chr(233))
TracesLog("chemin = " & chemin)
DeplacerFichiers colFiles, chemin, False
 
'FICHIERS FACTURES
'*****************
TracesLog("DEBUT TRAITEMENT FICHERS FACTURES : REPERTOIRE TELECHARGEMENT")
repScan = REP_REQ_TELECHARGT
requete = "Select * from CIM_DataFile Where Drive = 'D:' and Path = " & repScan & "and FileName like '% Facture%'"
TracesLog("Requête : " & requete)
set colFiles = objWMIService.ExecQuery (requete)
 
'Traitement en lien avec l'encodage et les accents le script est en UTF8 et window en windows 1250 (chr(233) = "é"
chemin = Replace(REP_FACTURES,"é",chr(233))
TracesLog("chemin = " & chemin)
DeplacerFichiers colFiles, chemin, False
 
TracesLog("DEBUT TRAITEMENT FICHERS FACTURES : RÉPERTOIRE _SCANS")
repScan = REP_REQ_SCAN
requete = "Select * from CIM_DataFile Where Drive = 'D:' and Path = " & repScan & "and FileName like '% Facture%'"
TracesLog("Requête : " & requete)
set colFiles = objWMIService.ExecQuery (requete)
TracesLog("chemin = " & chemin)
DeplacerFichiers colFiles, chemin, False
 
 
' Destruction des objets
Set Shell = Nothing
Set env = Nothing
 
 
'///////////////////////////////// FIN DU SCRIPT /////////////////////////////
TracesLog(" ///// FIN DU SCRIPT //////")
TracesLog(" ***")
MsgBox "Fin du script !", vbOKOnly + vbInformation, "Informations"
Set fsot = Nothing
 
Set oShell = WScript.CreateObject ("WScript.Shell")
'In VBScript, string literals are surrounded by double quotes
oShell.run """%ProgramFiles%\Notepad++\notepad++.exe ""C:\Users\antoi\Downloads\Log_Fichiers_EC.log"" "
Set oShell = Nothing
 
WScript.Quit

erreur sur un GOTO en vbs

laurent27530 — Wed, 30 Jul 2025 07:55:58 GMT

Bonjour mon code me retourne une erreur que j'arrive pas a supprimer sur la ligne 24 "GoTo FichierSuivant"

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Option Explicit
 
Dim fso, dossier, fichier, ligne, lignes, i
Dim cheminDossier, colonnes, idxHeure, idxStatut, valeurHeure, valeurStatut
Dim tsIn, tsOut, enTete
 
cheminDossier = "C:\TEMP\"
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(cheminDossier)
 
For Each fichier In dossier.Files
 
    If LCase(fso.GetExtensionName(fichier.Name)) = "csv" Then
 
        ' Gérer les erreurs pour ce fichier uniquement
        On Error Resume Next
 
        Set tsIn = fso.OpenTextFile(fichier.Path, 1, False, -1)
        If Err.Number <> 0 Then
            WScript.Echo "Erreur ouverture : " & fichier.Name
            Err.Clear
            On Error GoTo 0
            GoTo FichierSuivant
        End If
 
        On Error GoTo 0 ' Réactiver les erreurs
 
        If Not tsIn.AtEndOfStream Then
            enTete = tsIn.ReadLine
            colonnes = Split(enTete, ",")
            idxHeure = -1
            idxStatut = -1
 
            For i = 0 To UBound(colonnes)
                If Trim(colonnes(i)) = "Heures" Then idxHeure = i
                If Trim(colonnes(i)) = "Statut d’approbation" Then idxStatut = i
            Next
 
            If idxHeure = -1 Or idxStatut = -1 Then
                WScript.Echo "Colonnes manquantes dans : " & fichier.Name
                tsIn.Close
                GoTo FichierSuivant
            End If
 
            lignes = Array()
            ReDim Preserve lignes(0)
            lignes(0) = enTete
 
            Do Until tsIn.AtEndOfStream
                ligne = tsIn.ReadLine
                If Trim(ligne) <> "" Then
                    Dim champs
                    champs = Split(ligne, ",")
                    If UBound(champs) >= idxStatut Then
                        valeurHeure = Trim(champs(idxHeure))
                        valeurStatut = Trim(champs(idxStatut))
                        If valeurHeure <> "" And valeurHeure <> "0" Then
                            If valeurStatut = "Approuvé" Then
                                ReDim Preserve lignes(UBound(lignes) + 1)
                                lignes(UBound(lignes)) = ligne
                            End If
                        End If
                    End If
                End If
            Loop
        End If
 
        tsIn.Close
 
        ' Écriture sécurisée
        On Error Resume Next
        Set tsOut = fso.CreateTextFile(cheminDossier & "filtré_" & fichier.Name, True, True)
        If Err.Number <> 0 Then
            WScript.Echo "Erreur écriture : " & fichier.Name
            Err.Clear
            On Error GoTo 0
            GoTo FichierSuivant
        End If
        On Error GoTo 0
 
        For i = 0 To UBound(lignes)
            tsOut.WriteLine lignes(i)
        Next
        tsOut.Close
 
        WScript.Echo "Fichier filtré : " & fichier.Name
 
    End If
 
FichierSuivant:
Next
 
WScript.Echo "Traitement terminé."

VBS recuperation de colonnes plus formatage de certaines

laurent27530 — Wed, 04 Jun 2025 08:41:28 GMT

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

Modification ancien fichier .vbs Win11 64bits !

cincap — Sun, 11 May 2025 03:44:19 GMT

Bonjour � toutes et � tous,

J'aimerai modifier ce code pour charger un fichier texte avec d�j� les dates par d�faut que l'on pourra modifier suivant les ann�es plut�t que de les renseigner en dur dans le code (t).

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
 
Dim lecture
 
Set lecture=CreateObject("sapi.spvoice")
 
lecture.rate=1
lecture.volume = 100
 
'Pour 2025 
dim MesDate(12),TheMois
 
For t = 1 to 12
        select case t               
                Case 11: MesDate(t) = DateSerial(2025,int(t),21)
                Case 1,2,3,7,10: MesDate(t) = DateSerial(2025,int(t),24)
                case 8: MesDate(t) = DateSerial(2025,int(t),22)
                case 4,5,6: MesDate(t) = DateSerial(2025,int(t),23)
                Case 12: MesDate(t) = DateSerial(2025,int(t),19)
 
end select
next
 
'exemple d'utilisation pour le mois en cours
TheMois = Month(Now)
 
lecture.speak "Plus que " & DateDiff("d",now,MesDate(TheMois)) & " Jours"  & vbCrlf & " Avant de toucher ma pension"

Fichier texte que l'on pourra modifier :

Citation:

Janvier 24/01/2025

F�vrier 24/02/2025

Mars 24/03/2025

Avril 23/04/2025

Mai 23/05/2025 + Cong�s pay�

Juin 23/06/2025

Juillet 24/07/2025

Ao�t 22/08/2025

Septembre 23/09/2025

Octobre 24/10/2025

Novembre 21/11/2025

D�cembre 19/12/2025

Et enfin pour le mois de mai ajouter ceci "Avant de toucher ma pension et mes cong�s pay�s".

En vous remerciant d'avance,

@+,

cincap