Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

ShellWait - erreur de compilation...

17 réponses
Avatar
ben
Bonjour,

J'ai un soucis avec la commaNde ShellWait :

Erreur de compilation:
Variable ou procédure attendue, et non un module

Ma déclaration :
*********************************************
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess
As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess
As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400

Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo,
vbMinimizedNoFocus))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents
Sleep 100
Loop While RetVal = STILL_ACTIVE

*******************************************
Ma macro :

Sub addResrv_multi_line()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer

'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
' msgbox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:\addResrv_multi_line" & A & ".txt"
'toexe = "cmd.exe /c" & Valeur & ">>C:\addResrv_multi_line.txt"
toexe = "cmd.exe /c" & Valeur & " | clip "
MsgBox toexe
RetVal = ShellWait(toexe, vbHide)
Valeur = "" 'après chaque boucle il vide le contenu de la variable Valeur
Next
End If
'Open "C:\addResrv_multi_line.txt" For Input As #1
MsgBox "end"
End Sub
*****************************************************
Merci d'avance.
Cordialement.

10 réponses

1 2
Avatar
Mgr T. Banni
bonjour ben
ne serait-ce pas plutôt ShellAndWait?
enfin, je vous dis cela à tout hasard, mon fils, comme je dis parfois à mes
ouailles que Jésus est mort d'une rafale de mitraillette
Mgr T.B.

"ben" a écrit dans le message de news:

Bonjour,

J'ai un soucis avec la commaNde ShellWait :

Erreur de compilation:
Variable ou procédure attendue, et non un module

Ma déclaration :
*********************************************
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess
As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess
As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400

Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo,
vbMinimizedNoFocus))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents
Sleep 100
Loop While RetVal = STILL_ACTIVE

*******************************************
Ma macro :

Sub addResrv_multi_line()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer

'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
' msgbox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line" & A &
".txt"
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt"
toexe = "cmd.exe /c" & Valeur & " | clip "
MsgBox toexe
RetVal = ShellWait(toexe, vbHide)
Valeur = "" 'après chaque boucle il vide le contenu de la variable
Valeur
Next
End If
'Open "C:addResrv_multi_line.txt" For Input As #1
MsgBox "end"
End Sub
*****************************************************
Merci d'avance.
Cordialement.



Avatar
michdenis
En passant, dans le code que tu as publié, il te manque un
"End sub" à la procédure :
Public Sub ShellWait(ByVal JobToDo As String)


Je crois que cela se rapproche de ce que tu désires
Tu places tout ce code dans un module standard :

Exemple comment j'ai testé cette procédure :
Dans 2 cellules , j'ai placé une commande DOS qui s'exécute
habituellement dans une fenêtre DOS
En A1 : dir C:UsersPowerUserDocumentsDenis
En A2 : dir C:UsersPowerUser
Ce sont des commandes simples qui affichent le contenu du répertoire

Je sélectionne les cellules A1:A2 et j'appelle la macro "Test_And_Wait"
Une premère fenêtre s'ouvre avec la liste du répertoire, je ferme
la fenêtre DOS et une deuxième fenêtre s'ouvre avec le contenu
du second répertoire.

'utilisation de fonctions API , Déclaration dans le haut du module
Declare Function WaitForSingleObject Lib "Kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function OpenProcess Lib "Kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Public Const INFINITE = &HFFFF
'------------------------------------
Function LanceEtAttendLaFin(ByVal CheminComplet As String) As Long
Dim ProcessHandle As Long
Dim ProcessId As Long, ret&

ProcessId = Shell(CheminComplet, vbNormalFocus)
ProcessHandle = OpenProcess(&H1F0000, 0, ProcessId)
LanceEtAttendLaFin = WaitForSingleObject(ProcessHandle, INFINITE)
End Function
'------------------------------------
Function WaitForEnd(Fichier) As Long
Set wsh = CreateObject("WScript.Shell")
WaitForEnd = wsh.Run(Fichier, 1, True)
End Function
'------------------------------------
Sub Test_And_Wait()
Dim C As Range
If TypeName(Selection) = "Range" Then
For Each C In Selection.Cells
chemin = "c:Windowssystem32cmd.exe /K " & C
WaitForEnd chemin
Next
End If
End Sub
'------------------------------------



"ben" a écrit dans le message de groupe de discussion :

Bonjour,

J'ai un soucis avec la commaNde ShellWait :

Erreur de compilation:
Variable ou procédure attendue, et non un module

Ma déclaration :
*********************************************
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess
As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess
As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400

Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo,
vbMinimizedNoFocus))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents
Sleep 100
Loop While RetVal = STILL_ACTIVE

*******************************************
Ma macro :

Sub addResrv_multi_line()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer

'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
' msgbox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line" & A & ".txt"
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt"
toexe = "cmd.exe /c" & Valeur & " | clip "
MsgBox toexe
RetVal = ShellWait(toexe, vbHide)
Valeur = "" 'après chaque boucle il vide le contenu de la variable Valeur
Next
End If
'Open "C:addResrv_multi_line.txt" For Input As #1
MsgBox "end"
End Sub
*****************************************************
Merci d'avance.
Cordialement.
Avatar
michdenis
Voici une version simplifier et "améliorer" de ce que tu veux
faire en passant pas la création d'un batchfile à la volée.

Comme dans le message précédent, chaque cellule contient
la commande à exécuter ... comme dans ton cas, la commande
est la même, tu peux modifier la création du texte du batchfile
et mettre dans la cellule que tes variables...

Ce qui suit a dans les cellules de la sélection des commmandes du genre :
dir C:UsersPowerUserDocumentsDenis

Et lors de l'exécution du batchfile tu n'as qu'à appuyer sur une touche
pour passer à l'exécution de la commande suivante. Ce qui suit
ne demande aucun API.

'----------------------------------
Sub Créer_Et_Exécuter_Un_BatFile()
Dim Fichier As String, Chemin As String
Dim X As Long, C As Range
X = FreeFile

'Où tu veux que le fichier soit créer
Chemin = "C:UsersPoweruser"
'Nom du batchfile à créer
Fichier = "Denis1.bat"

On Error Resume Next
'Supprimer le fichier si il existe déjà
Kill Chemin & Fichier
'supprime l'erreur au cas où le fichier n'exite pas
Err.Clear
'S'assure que la selection est une plage de cellule

If TypeName(Selection) = "Range" Then
'Ce qui suit met dans la variable "texte" la
'composition des lignes de code du BatchFile
texte = "Echo on " & vbCrLf
For Each C In Selection.Cells
If C <> "" Then
texte = texte & C & vbCrLf
texte = texte & "Pause" & vbCrLf
End If
Next
texte = texte & "exit"
End If
'Création du fichier lui-même
Open Chemin & Fichier For Append As #X
'Copie de la variable dans le fichier
Print #X, texte
'Fermeture du fichier batchfile
Close #X
'Exécution du BatchFile
Shell "Cmd.exe /K " & Chemin & Fichier
End Sub
'----------------------------------



"ben" a écrit dans le message de groupe de discussion :

Bonjour,

J'ai un soucis avec la commaNde ShellWait :

Erreur de compilation:
Variable ou procédure attendue, et non un module

Ma déclaration :
*********************************************
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess
As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess
As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400

Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo,
vbMinimizedNoFocus))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents
Sleep 100
Loop While RetVal = STILL_ACTIVE

*******************************************
Ma macro :

Sub addResrv_multi_line()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer

'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
' msgbox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line" & A & ".txt"
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt"
toexe = "cmd.exe /c" & Valeur & " | clip "
MsgBox toexe
RetVal = ShellWait(toexe, vbHide)
Valeur = "" 'après chaque boucle il vide le contenu de la variable Valeur
Next
End If
'Open "C:addResrv_multi_line.txt" For Input As #1
MsgBox "end"
End Sub
*****************************************************
Merci d'avance.
Cordialement.
Avatar
Mgr T. Banni
Mon Dieu, pardonne à ton fils égaré mais dis leur avant quel c.. il fait
dans cette affaire puisqu'une sub peut bien s'appeler comme on veut...un peu
comme Dieu finalement
Mgr T.B.

"Mgr T. Banni" a écrit dans le message de news:

bonjour ben
ne serait-ce pas plutôt ShellAndWait?
enfin, je vous dis cela à tout hasard, mon fils, comme je dis parfois à
mes ouailles que Jésus est mort d'une rafale de mitraillette
Mgr T.B.

"ben" a écrit dans le message de news:

Bonjour,

J'ai un soucis avec la commaNde ShellWait :

Erreur de compilation:
Variable ou procédure attendue, et non un module

Ma déclaration :
*********************************************
Private Declare Function OpenProcess Lib "kernel32" (ByVal
dwDesiredAccess
As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal
hProcess
As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400

Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False,
Shell(JobToDo,
vbMinimizedNoFocus))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents
Sleep 100
Loop While RetVal = STILL_ACTIVE

*******************************************
Ma macro :

Sub addResrv_multi_line()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer

'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
' msgbox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line" & A &
".txt"
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt"
toexe = "cmd.exe /c" & Valeur & " | clip "
MsgBox toexe
RetVal = ShellWait(toexe, vbHide)
Valeur = "" 'après chaque boucle il vide le contenu de la variable
Valeur
Next
End If
'Open "C:addResrv_multi_line.txt" For Input As #1
MsgBox "end"
End Sub
*****************************************************
Merci d'avance.
Cordialement.







Avatar
michdenis
Cette procédure fait exactement ce que tu désires.
Avec celle-ci, tu ne dois pas mettre la commande
"nslookup" dans la cellule, tu n'as comme tu désires
à saisir la valeur de la variable que tu veux tester.

Tu sélectionnes ta liste et tu lances la procédure.

P.S- N'oublie pas de modifier le chemin et le
nom du batchFile que tu vas créer .

'------------------------------------------
Sub Créer_Et_Exécuter_Un_BatFile()
Dim Fichier As String, Chemin As String
Dim X As Long, C As Range, Texte As String
X = FreeFile

'******* À RENSEIGNER ********
'Où tu veux que le fichier soit créer
Chemin = "C:UsersPoweruser"
'Nom du batchfile à créer
Fichier = "Denis.bat"
'*******************************
On Error Resume Next
'Supprimer le fichier si il existe déjà
Kill Chemin & Fichier
'supprime l'erreur au cas où le fichier n'exite pas
Err.Clear
'S'assure que la selection est une plage de cellule

If TypeName(Selection) = "Range" Then
'Ce qui suit met dans la variable "texte" la
'composition des lignes de code du BatchFile
Texte = "Echo on " & vbCrLf
Texte = "cd" & vbCrLf
Texte = texte & "c:" & vbCrLf
Texte = texte & "Cls" & vbCrLf
For Each C In Selection.Cells
If C <> "" Then
texte = Texte & "nslookup.exe " & C & vbCrLf
texte = Texte & "Pause" & vbCrLf
End If
Next
Texte = Texte & "exit"
End If
'Création du fichier lui-même
Open Chemin & Fichier For Append As #X
'Copie de la variable dans le fichier
Print #X, Texte
'Fermeture du fichier batchfile
Close #X
'Exécution du BatchFile
Shell "Cmd.exe /K " & Chemin & Fichier, vbNormalFocus
End Sub
'------------------------------------------
Avatar
ben
Bonjour michdenis,

Voici ma solution, cependant j'aimerais juste rajouter la date d'exécution
pour chaque traitement, car j'ai qu'un seule fichier.
************************************************
Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

'Sub Test()
'Dim StartTime As Double
'StartTime = Now
'ShellAndWait "ping.exe", 1
'MsgBox "Gone " & Format(Now - StartTime, "s") & " seconds"
'End Sub
Sub addResrv_multi_line_test()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer
Dim LogFile As String
'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
'MsgBox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line" & A & ".txt"
ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1
'ShellAndWait "cmd.exe /c" & Valeur & " | clip ", 1
Valeur = "" 'après chaque boucle il vide le contenu de la variable Valeur
Next
End If

Dim wshShell
Set wshShell = CreateObject("wscript.shell")
'Execution du fichier - ouverture d'un fichier txt
wshShell.Run "C:addResrv_multi_line.txt"

End Sub


'Window States (Per Help for Shell function):
' 1, 5, 9 Normal with focus.
' 2 Minimized with focus.
' 3 Maximized with focus.
' 4, 8 Normal without focus.
' 6, 7 Minimized without focus.
Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long

'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub


************************************************

Cordialement.


"michdenis" wrote:

Cette procédure fait exactement ce que tu désires.
Avec celle-ci, tu ne dois pas mettre la commande
"nslookup" dans la cellule, tu n'as comme tu désires
à saisir la valeur de la variable que tu veux tester.

Tu sélectionnes ta liste et tu lances la procédure.

P.S- N'oublie pas de modifier le chemin et le
nom du batchFile que tu vas créer .

'------------------------------------------
Sub Créer_Et_Exécuter_Un_BatFile()
Dim Fichier As String, Chemin As String
Dim X As Long, C As Range, Texte As String
X = FreeFile

'******* À RENSEIGNER ********
'Où tu veux que le fichier soit créer
Chemin = "C:UsersPoweruser"
'Nom du batchfile à créer
Fichier = "Denis.bat"
'*******************************
On Error Resume Next
'Supprimer le fichier si il existe déjà
Kill Chemin & Fichier
'supprime l'erreur au cas où le fichier n'exite pas
Err.Clear
'S'assure que la selection est une plage de cellule

If TypeName(Selection) = "Range" Then
'Ce qui suit met dans la variable "texte" la
'composition des lignes de code du BatchFile
Texte = "Echo on " & vbCrLf
Texte = "cd" & vbCrLf
Texte = texte & "c:" & vbCrLf
Texte = texte & "Cls" & vbCrLf
For Each C In Selection.Cells
If C <> "" Then
texte = Texte & "nslookup.exe " & C & vbCrLf
texte = Texte & "Pause" & vbCrLf
End If
Next
Texte = Texte & "exit"
End If
'Création du fichier lui-même
Open Chemin & Fichier For Append As #X
'Copie de la variable dans le fichier
Print #X, Texte
'Fermeture du fichier batchfile
Close #X
'Exécution du BatchFile
Shell "Cmd.exe /K " & Chemin & Fichier, vbNormalFocus
End Sub
'------------------------------------------







Avatar
michdenis
Attention aux coupures de lignes de code par le service de messagerie.

N.B. Semble-t-il que la solution retenue s'est éloignée de ta
demande initiale !

Dans ton code, avant cette ligne de la procédure: Test
ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1

Tu inscris les commandes dans cet ordre :
Tu peux aussi modifier le format date que tu désires dans "dd/mmm/yyyy H:MM:SS"
commande = "cmd.exe /c Echo La date et l'heure de l'exécution est : " _
& Format(Now, "dd/mmm/yyyy H:MM:SS") & ">>C:addResrv_multi_line.txt"
Shell commande, vbHide
ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1

P.S- Tu dois ajouter à la déclaration des variables en début de procédure
Dim Commande As String


"ben" a écrit dans le message de groupe de discussion :

Bonjour michdenis,

Voici ma solution, cependant j'aimerais juste rajouter la date d'exécution
pour chaque traitement, car j'ai qu'un seule fichier.
************************************************
Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

'Sub Test()
'Dim StartTime As Double
'StartTime = Now
'ShellAndWait "ping.exe", 1
'MsgBox "Gone " & Format(Now - StartTime, "s") & " seconds"
'End Sub
Sub addResrv_multi_line_test()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer
Dim LogFile As String
'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
'MsgBox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line" & A & ".txt"

ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1
'ShellAndWait "cmd.exe /c" & Valeur & " | clip ", 1
Valeur = "" 'après chaque boucle il vide le contenu de la variable Valeur
Next
End If

Dim wshShell
Set wshShell = CreateObject("wscript.shell")
'Execution du fichier - ouverture d'un fichier txt
wshShell.Run "C:addResrv_multi_line.txt"

End Sub


'Window States (Per Help for Shell function):
' 1, 5, 9 Normal with focus.
' 2 Minimized with focus.
' 3 Maximized with focus.
' 4, 8 Normal without focus.
' 6, 7 Minimized without focus.
Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long

'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub


************************************************

Cordialement.


"michdenis" wrote:

Cette procédure fait exactement ce que tu désires.
Avec celle-ci, tu ne dois pas mettre la commande
"nslookup" dans la cellule, tu n'as comme tu désires
à saisir la valeur de la variable que tu veux tester.

Tu sélectionnes ta liste et tu lances la procédure.

P.S- N'oublie pas de modifier le chemin et le
nom du batchFile que tu vas créer .

'------------------------------------------
Sub Créer_Et_Exécuter_Un_BatFile()
Dim Fichier As String, Chemin As String
Dim X As Long, C As Range, Texte As String
X = FreeFile

'******* À RENSEIGNER ********
'Où tu veux que le fichier soit créer
Chemin = "C:UsersPoweruser"
'Nom du batchfile à créer
Fichier = "Denis.bat"
'*******************************
On Error Resume Next
'Supprimer le fichier si il existe déjà
Kill Chemin & Fichier
'supprime l'erreur au cas où le fichier n'exite pas
Err.Clear
'S'assure que la selection est une plage de cellule

If TypeName(Selection) = "Range" Then
'Ce qui suit met dans la variable "texte" la
'composition des lignes de code du BatchFile
Texte = "Echo on " & vbCrLf
Texte = "cd" & vbCrLf
Texte = texte & "c:" & vbCrLf
Texte = texte & "Cls" & vbCrLf
For Each C In Selection.Cells
If C <> "" Then
texte = Texte & "nslookup.exe " & C & vbCrLf
texte = Texte & "Pause" & vbCrLf
End If
Next
Texte = Texte & "exit"
End If
'Création du fichier lui-même
Open Chemin & Fichier For Append As #X
'Copie de la variable dans le fichier
Print #X, Texte
'Fermeture du fichier batchfile
Close #X
'Exécution du BatchFile
Shell "Cmd.exe /K " & Chemin & Fichier, vbNormalFocus
End Sub
'------------------------------------------







Avatar
michdenis
Les 2 lignes ajoutées vont s'exécuter pour tous les items
contenus dans la boucle. Si tu ne désires inscrire une date
que pour l'ensemble du code contenu dans la boucle,
place ces 2 lignes de code avant le début de la ligne For ...
de la même procédure.

commande = "cmd.exe /c Echo La date et l'heure de l'exécution est : " _
& Format(Now, "dd/mmm/yyyy H:MM:SS") & ">>C:addResrv_multi_line.txt"
Shell commande, vbHide


"michdenis" a écrit dans le message de groupe de discussion :
#
Attention aux coupures de lignes de code par le service de messagerie.

N.B. Semble-t-il que la solution retenue s'est éloignée de ta
demande initiale !

Dans ton code, avant cette ligne de la procédure: Test
ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1

Tu inscris les commandes dans cet ordre :
Tu peux aussi modifier le format date que tu désires dans "dd/mmm/yyyy H:MM:SS"
commande = "cmd.exe /c Echo La date et l'heure de l'exécution est : " _
& Format(Now, "dd/mmm/yyyy H:MM:SS") & ">>C:addResrv_multi_line.txt"
Shell commande, vbHide
ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1

P.S- Tu dois ajouter à la déclaration des variables en début de procédure
Dim Commande As String


"ben" a écrit dans le message de groupe de discussion :

Bonjour michdenis,

Voici ma solution, cependant j'aimerais juste rajouter la date d'exécution
pour chaque traitement, car j'ai qu'un seule fichier.
************************************************
Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

'Sub Test()
'Dim StartTime As Double
'StartTime = Now
'ShellAndWait "ping.exe", 1
'MsgBox "Gone " & Format(Now - StartTime, "s") & " seconds"
'End Sub
Sub addResrv_multi_line_test()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer
Dim LogFile As String
'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
'MsgBox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line" & A & ".txt"

ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1
'ShellAndWait "cmd.exe /c" & Valeur & " | clip ", 1
Valeur = "" 'après chaque boucle il vide le contenu de la variable Valeur
Next
End If

Dim wshShell
Set wshShell = CreateObject("wscript.shell")
'Execution du fichier - ouverture d'un fichier txt
wshShell.Run "C:addResrv_multi_line.txt"

End Sub


'Window States (Per Help for Shell function):
' 1, 5, 9 Normal with focus.
' 2 Minimized with focus.
' 3 Maximized with focus.
' 4, 8 Normal without focus.
' 6, 7 Minimized without focus.
Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long

'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub


************************************************

Cordialement.


"michdenis" wrote:

Cette procédure fait exactement ce que tu désires.
Avec celle-ci, tu ne dois pas mettre la commande
"nslookup" dans la cellule, tu n'as comme tu désires
à saisir la valeur de la variable que tu veux tester.

Tu sélectionnes ta liste et tu lances la procédure.

P.S- N'oublie pas de modifier le chemin et le
nom du batchFile que tu vas créer .

'------------------------------------------
Sub Créer_Et_Exécuter_Un_BatFile()
Dim Fichier As String, Chemin As String
Dim X As Long, C As Range, Texte As String
X = FreeFile

'******* À RENSEIGNER ********
'Où tu veux que le fichier soit créer
Chemin = "C:UsersPoweruser"
'Nom du batchfile à créer
Fichier = "Denis.bat"
'*******************************
On Error Resume Next
'Supprimer le fichier si il existe déjà
Kill Chemin & Fichier
'supprime l'erreur au cas où le fichier n'exite pas
Err.Clear
'S'assure que la selection est une plage de cellule

If TypeName(Selection) = "Range" Then
'Ce qui suit met dans la variable "texte" la
'composition des lignes de code du BatchFile
Texte = "Echo on " & vbCrLf
Texte = "cd" & vbCrLf
Texte = texte & "c:" & vbCrLf
Texte = texte & "Cls" & vbCrLf
For Each C In Selection.Cells
If C <> "" Then
texte = Texte & "nslookup.exe " & C & vbCrLf
texte = Texte & "Pause" & vbCrLf
End If
Next
Texte = Texte & "exit"
End If
'Création du fichier lui-même
Open Chemin & Fichier For Append As #X
'Copie de la variable dans le fichier
Print #X, Texte
'Fermeture du fichier batchfile
Close #X
'Exécution du BatchFile
Shell "Cmd.exe /K " & Chemin & Fichier, vbNormalFocus
End Sub
'------------------------------------------







Avatar
ben
Bonjour,

Et merci infiniment pour votre aide.

J'aimerais pour finaliser le projet faire au cas ou, un clear du fichier
txt ?.
Ou bien la suppression du fichier s'il existe avant l'execution.

Merci de me faire les 2 propositions.

Cordialement.



"michdenis" wrote:

Les 2 lignes ajoutées vont s'exécuter pour tous les items
contenus dans la boucle. Si tu ne désires inscrire une date
que pour l'ensemble du code contenu dans la boucle,
place ces 2 lignes de code avant le début de la ligne For ...
de la même procédure.

commande = "cmd.exe /c Echo La date et l'heure de l'exécution est : " _
& Format(Now, "dd/mmm/yyyy H:MM:SS") & ">>C:addResrv_multi_line.txt"
Shell commande, vbHide


"michdenis" a écrit dans le message de groupe de discussion :
#
Attention aux coupures de lignes de code par le service de messagerie.

N.B. Semble-t-il que la solution retenue s'est éloignée de ta
demande initiale !

Dans ton code, avant cette ligne de la procédure: Test
ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1

Tu inscris les commandes dans cet ordre :
Tu peux aussi modifier le format date que tu désires dans "dd/mmm/yyyy H:MM:SS"
commande = "cmd.exe /c Echo La date et l'heure de l'exécution est : " _
& Format(Now, "dd/mmm/yyyy H:MM:SS") & ">>C:addResrv_multi_line.txt"
Shell commande, vbHide
ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1

P.S- Tu dois ajouter à la déclaration des variables en début de procédure
Dim Commande As String


"ben" a écrit dans le message de groupe de discussion :

Bonjour michdenis,

Voici ma solution, cependant j'aimerais juste rajouter la date d'exécution
pour chaque traitement, car j'ai qu'un seule fichier.
************************************************
Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

'Sub Test()
'Dim StartTime As Double
'StartTime = Now
'ShellAndWait "ping.exe", 1
'MsgBox "Gone " & Format(Now - StartTime, "s") & " seconds"
'End Sub
Sub addResrv_multi_line_test()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer
Dim LogFile As String
'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
'MsgBox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line" & A & ".txt"

ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1
'ShellAndWait "cmd.exe /c" & Valeur & " | clip ", 1
Valeur = "" 'après chaque boucle il vide le contenu de la variable Valeur
Next
End If

Dim wshShell
Set wshShell = CreateObject("wscript.shell")
'Execution du fichier - ouverture d'un fichier txt
wshShell.Run "C:addResrv_multi_line.txt"

End Sub


'Window States (Per Help for Shell function):
' 1, 5, 9 Normal with focus.
' 2 Minimized with focus.
' 3 Maximized with focus.
' 4, 8 Normal without focus.
' 6, 7 Minimized without focus.
Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long

'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub


************************************************

Cordialement.


"michdenis" wrote:

> Cette procédure fait exactement ce que tu désires.
> Avec celle-ci, tu ne dois pas mettre la commande
> "nslookup" dans la cellule, tu n'as comme tu désires
> à saisir la valeur de la variable que tu veux tester.
>
> Tu sélectionnes ta liste et tu lances la procédure.
>
> P.S- N'oublie pas de modifier le chemin et le
> nom du batchFile que tu vas créer .
>
> '------------------------------------------
> Sub Créer_Et_Exécuter_Un_BatFile()
> Dim Fichier As String, Chemin As String
> Dim X As Long, C As Range, Texte As String
> X = FreeFile
>
> '******* À RENSEIGNER ********
> 'Où tu veux que le fichier soit créer
> Chemin = "C:UsersPoweruser"
> 'Nom du batchfile à créer
> Fichier = "Denis.bat"
> '*******************************
> On Error Resume Next
> 'Supprimer le fichier si il existe déjà
> Kill Chemin & Fichier
> 'supprime l'erreur au cas où le fichier n'exite pas
> Err.Clear
> 'S'assure que la selection est une plage de cellule
>
> If TypeName(Selection) = "Range" Then
> 'Ce qui suit met dans la variable "texte" la
> 'composition des lignes de code du BatchFile
> Texte = "Echo on " & vbCrLf
> Texte = "cd" & vbCrLf
> Texte = texte & "c:" & vbCrLf
> Texte = texte & "Cls" & vbCrLf
> For Each C In Selection.Cells
> If C <> "" Then
> texte = Texte & "nslookup.exe " & C & vbCrLf
> texte = Texte & "Pause" & vbCrLf
> End If
> Next
> Texte = Texte & "exit"
> End If
> 'Création du fichier lui-même
> Open Chemin & Fichier For Append As #X
> 'Copie de la variable dans le fichier
> Print #X, Texte
> 'Fermeture du fichier batchfile
> Close #X
> 'Exécution du BatchFile
> Shell "Cmd.exe /K " & Chemin & Fichier, vbNormalFocus
> End Sub
> '------------------------------------------
>
>
>
>
>


Avatar
michdenis
Voici quelques explications sur cette ligne de commande :
ShellAndWait "cmd.exe /c " & Valeur & ">>C:addResrv_multi_line.txt", 1

L'utilisation des ">>" permet d'ajouter le résultat d'une commande DOS
à l'information du fichier déjà existant si le fichier n'est pas vide.
tu peux si tu le désires effacer et écrire le résultat de la
commande en utilisant un seul ">" dans la commande.
ShellAndWait "cmd.exe /c " & Valeur & ">C:addResrv_multi_line.txt", 1

On pourrait aussi le faire de cette façon en détournant un peu le rôle
de la commande "Echo off" en DOS comme ceci :
Dans votre programme, cela se traduit de façon suivante
Commande = commande = "cmd.exe /c echo off >C:addResrv_multi_line.txt"
Shell commande, vbHide
Vous insérez ces 2 lignes de code avant le début de la boucle. Cela videra
complètement le contenu du fichier existant.

Pour supprimer un fichier existant
Kill C:addResrv_multi_line.txt

Attention, le fichier est totalement détruit, il ne se
retrouve pas à la poubelle de Windows.

Pour effacer le contenu du fichier texte, vous pouvez utiliser
la même commande :



"ben" a écrit dans le message de groupe de discussion :

Bonjour,

Et merci infiniment pour votre aide.

J'aimerais pour finaliser le projet faire au cas ou, un clear du fichier
txt ?.
Ou bien la suppression du fichier s'il existe avant l'execution.

Merci de me faire les 2 propositions.

Cordialement.



"michdenis" wrote:

Les 2 lignes ajoutées vont s'exécuter pour tous les items
contenus dans la boucle. Si tu ne désires inscrire une date
que pour l'ensemble du code contenu dans la boucle,
place ces 2 lignes de code avant le début de la ligne For ...
de la même procédure.

commande = "cmd.exe /c Echo La date et l'heure de l'exécution est : " _
& Format(Now, "dd/mmm/yyyy H:MM:SS") & ">>C:addResrv_multi_line.txt"
Shell commande, vbHide


"michdenis" a écrit dans le message de groupe de discussion :
#
Attention aux coupures de lignes de code par le service de messagerie.

N.B. Semble-t-il que la solution retenue s'est éloignée de ta
demande initiale !

Dans ton code, avant cette ligne de la procédure: Test
ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1

Tu inscris les commandes dans cet ordre :
Tu peux aussi modifier le format date que tu désires dans "dd/mmm/yyyy H:MM:SS"
commande = "cmd.exe /c Echo La date et l'heure de l'exécution est : " _
& Format(Now, "dd/mmm/yyyy H:MM:SS") & ">>C:addResrv_multi_line.txt"
Shell commande, vbHide
ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1

P.S- Tu dois ajouter à la déclaration des variables en début de procédure
Dim Commande As String


"ben" a écrit dans le message de groupe de discussion :

Bonjour michdenis,

Voici ma solution, cependant j'aimerais juste rajouter la date d'exécution
pour chaque traitement, car j'ai qu'un seule fichier.
************************************************
Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

'Sub Test()
'Dim StartTime As Double
'StartTime = Now
'ShellAndWait "ping.exe", 1
'MsgBox "Gone " & Format(Now - StartTime, "s") & " seconds"
'End Sub
Sub addResrv_multi_line_test()
' il faut sélectionner plusieurs valeurs de la ligne
Dim Cell As Range, Ligne As Range, Valeur, A As Integer
Dim LogFile As String
'vérifier si Selection est une plage de cellules
If TypeName(Selection) = "Range" Then
'Boucle sur chaque ligne de la sélection
For Each Ligne In Selection.Rows
'Boucle sur chaque cellule de la ligne
For Each Cell In Ligne.Cells
Valeur = Valeur & " " & Cell.Value
' résultats intermédiaires
'MsgBox valeur
Next Cell
'MsgBox Valeur
'A = A + 1
'toexe = "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line" & A & ".txt"

ShellAndWait "cmd.exe /c" & Valeur & ">>C:addResrv_multi_line.txt", 1
'ShellAndWait "cmd.exe /c" & Valeur & " | clip ", 1
Valeur = "" 'après chaque boucle il vide le contenu de la variable Valeur
Next
End If

Dim wshShell
Set wshShell = CreateObject("wscript.shell")
'Execution du fichier - ouverture d'un fichier txt
wshShell.Run "C:addResrv_multi_line.txt"

End Sub


'Window States (Per Help for Shell function):
' 1, 5, 9 Normal with focus.
' 2 Minimized with focus.
' 3 Maximized with focus.
' 4, 8 Normal without focus.
' 6, 7 Minimized without focus.
Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long

'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub


************************************************

Cordialement.


"michdenis" wrote:

> Cette procédure fait exactement ce que tu désires.
> Avec celle-ci, tu ne dois pas mettre la commande
> "nslookup" dans la cellule, tu n'as comme tu désires
> à saisir la valeur de la variable que tu veux tester.
>
> Tu sélectionnes ta liste et tu lances la procédure.
>
> P.S- N'oublie pas de modifier le chemin et le
> nom du batchFile que tu vas créer .
>
> '------------------------------------------
> Sub Créer_Et_Exécuter_Un_BatFile()
> Dim Fichier As String, Chemin As String
> Dim X As Long, C As Range, Texte As String
> X = FreeFile
>
> '******* À RENSEIGNER ********
> 'Où tu veux que le fichier soit créer
> Chemin = "C:UsersPoweruser"
> 'Nom du batchfile à créer
> Fichier = "Denis.bat"
> '*******************************
> On Error Resume Next
> 'Supprimer le fichier si il existe déjà
> Kill Chemin & Fichier
> 'supprime l'erreur au cas où le fichier n'exite pas
> Err.Clear
> 'S'assure que la selection est une plage de cellule
>
> If TypeName(Selection) = "Range" Then
> 'Ce qui suit met dans la variable "texte" la
> 'composition des lignes de code du BatchFile
> Texte = "Echo on " & vbCrLf
> Texte = "cd" & vbCrLf
> Texte = texte & "c:" & vbCrLf
> Texte = texte & "Cls" & vbCrLf
> For Each C In Selection.Cells
> If C <> "" Then
> texte = Texte & "nslookup.exe " & C & vbCrLf
> texte = Texte & "Pause" & vbCrLf
> End If
> Next
> Texte = Texte & "exit"
> End If
> 'Création du fichier lui-même
> Open Chemin & Fichier For Append As #X
> 'Copie de la variable dans le fichier
> Print #X, Texte
> 'Fermeture du fichier batchfile
> Close #X
> 'Exécution du BatchFile
> Shell "Cmd.exe /K " & Chemin & Fichier, vbNormalFocus
> End Sub
> '------------------------------------------
>
>
>
>
>


1 2