MsgBox incontournable? - Petit casse-tête pour experts
Le
Alain \(74\)
Bonjour à tous,
Ma question est à la fin du message
Pour lister les ordinateurs connectés sur un réseau peer to peer le code
suivant est utilisé dans un formulaire possédant un bouton nommé
"cmdCréeFichier":
***Clic sur le bouton cmdCréeFichier
Private Sub cmdCréeFichier_Click()
On Error Resume Next
Dim i As Integer
Kill "C:\listeréseau.txt" 'Supprime le fichier s'il existe
Dim k As String
If Left(GetWinVersion(), 1) = "4" Then
'Sous Windows 98
k = "C:\command.com /C NET VIEW >c:\listeréseau.txt"
Else
'Sous Win XP
k = "C:\windows\system32\command.com /C NET VIEW
>c:\listeréseau.txt"
End If
'DoEvents
Shell k, vbHide
MsgBox "La liste des ordinateurs du réseau a été enregistrée dans le
fichier listeréseau.txt situé dans le répertoire C:\"
LitFichier 'Appel à la fonction "LitFichier"
End Sub
****************************
Public Function LitFichier()
Dim Contenu As String
Dim ContenuFichier
DoEvents
Open "c:\listeréseau.txt" For Input As #1
Do While Not EOF(1) 'Boucle
Line Input #1, ContenuFichier 'Lecture de la ligne
If Trim(ContenuFichier) <> "" Then
If Left(Trim(ContenuFichier), 2) = "\\" Then
ContenuFichier = Trim(Mid(ContenuFichier, 3,
InStr(ContenuFichier, Chr(32))))
If Trim(Contenu) <> "" Then
Contenu = Contenu & Chr(13) & ContenuFichier
Else
Contenu = ContenuFichier
End If
End If
End If
Loop
Close #1
DoEvents
MsgBox "Les ordinateurs du réseau sont les suivants:" & vbCrLf & Contenu
End Function
*******************************
NOTA:
Un module global contient le code suivant permettant de déterminer la
version Windows avec la fonction GetWinVersion (On considère ici que l'on
est en 98 ou en XP)
Declare Function GetVersion Lib "Kernel32" () As Long
_____________________________________________
Function GetWinVersion()
Dim ver As Long, WinVer As Long, DosVer As Long
Dim WindowsVersion As String, DosVersion As String
ver = GetVersion()
WinVer = ver And &HFFF&
GetWinVersion = Format((WinVer Mod 256) + ((WinVer \ 256) / 100),
"Fixed")
End Function
_____________________________________________
QUESTION:
On obtient un résultat lorsque la ligne suivante est présente dans le code
"sur clic" du bouton cmdCréeFichier.
MsgBox "La liste des ordinateurs du réseau a été créée." & vbCrLf & "Le
fichier listeréseau.txt a été créé dans le répertoire C:\"
Si on neutralise cette ligne en la mettant en commentaire il n'y a plus de
résultat.
Quelqu'un connaît-il l'astuce pour éviter la ligne MsgBox?
Je peux adresser le fichier exemple à ceux qui sont intéressés.
Merci pour toutes vos suggestions
AE
Ma question est à la fin du message
Pour lister les ordinateurs connectés sur un réseau peer to peer le code
suivant est utilisé dans un formulaire possédant un bouton nommé
"cmdCréeFichier":
***Clic sur le bouton cmdCréeFichier
Private Sub cmdCréeFichier_Click()
On Error Resume Next
Dim i As Integer
Kill "C:\listeréseau.txt" 'Supprime le fichier s'il existe
Dim k As String
If Left(GetWinVersion(), 1) = "4" Then
'Sous Windows 98
k = "C:\command.com /C NET VIEW >c:\listeréseau.txt"
Else
'Sous Win XP
k = "C:\windows\system32\command.com /C NET VIEW
>c:\listeréseau.txt"
End If
'DoEvents
Shell k, vbHide
MsgBox "La liste des ordinateurs du réseau a été enregistrée dans le
fichier listeréseau.txt situé dans le répertoire C:\"
LitFichier 'Appel à la fonction "LitFichier"
End Sub
****************************
Public Function LitFichier()
Dim Contenu As String
Dim ContenuFichier
DoEvents
Open "c:\listeréseau.txt" For Input As #1
Do While Not EOF(1) 'Boucle
Line Input #1, ContenuFichier 'Lecture de la ligne
If Trim(ContenuFichier) <> "" Then
If Left(Trim(ContenuFichier), 2) = "\\" Then
ContenuFichier = Trim(Mid(ContenuFichier, 3,
InStr(ContenuFichier, Chr(32))))
If Trim(Contenu) <> "" Then
Contenu = Contenu & Chr(13) & ContenuFichier
Else
Contenu = ContenuFichier
End If
End If
End If
Loop
Close #1
DoEvents
MsgBox "Les ordinateurs du réseau sont les suivants:" & vbCrLf & Contenu
End Function
*******************************
NOTA:
Un module global contient le code suivant permettant de déterminer la
version Windows avec la fonction GetWinVersion (On considère ici que l'on
est en 98 ou en XP)
Declare Function GetVersion Lib "Kernel32" () As Long
_____________________________________________
Function GetWinVersion()
Dim ver As Long, WinVer As Long, DosVer As Long
Dim WindowsVersion As String, DosVersion As String
ver = GetVersion()
WinVer = ver And &HFFF&
GetWinVersion = Format((WinVer Mod 256) + ((WinVer \ 256) / 100),
"Fixed")
End Function
_____________________________________________
QUESTION:
On obtient un résultat lorsque la ligne suivante est présente dans le code
"sur clic" du bouton cmdCréeFichier.
MsgBox "La liste des ordinateurs du réseau a été créée." & vbCrLf & "Le
fichier listeréseau.txt a été créé dans le répertoire C:\"
Si on neutralise cette ligne en la mettant en commentaire il n'y a plus de
résultat.
Quelqu'un connaît-il l'astuce pour éviter la ligne MsgBox?
Je peux adresser le fichier exemple à ceux qui sont intéressés.
Merci pour toutes vos suggestions
AE
Poser une question
donc ne devrait pas poser de pbl (problème encore pardon). Mais peut-être
que ce message permet au fichier 'C:listeréseau.txt' de se créer. Tu peux
donc utiliser des doEvents pour redonner la main au système (hésite pas à en
mettre plusieurs voire même dans une boucle) ou alors essayer un
Application.Wait TimeSerial(hour(now), minute(now), seconde(now)+4) pour
attendre 4 secondes.
John
"Alain (74)" news:
Merci pour cet avis . Je ne l'avais pas précisé mais j'ai essayé tout ça en
vain (DoEvents, Attente etc...) Rien n'y fait.
Jusqu'à trouver l'astuce, je n'ai rien trouvé d'autre que faire appel à un
Msgbox pour voir le retour d'un résultat.
A première vue il semble que ce "défaut" est lié à la fonction shell qui est
utilisée... mais je n'ai pas trouvé de documentation suffisante sur le
sujet.
PS: Je ne connais pas la méthode WAIT de l'objet Application. Elle génère
chez moi un msg d'erreur et je n'ai trouvé aucune documentation à son sujet.
Est-ce une nouveauté d'ACCESS 2003? Je suis sous 2002.
AE
"John Fuss" news:brsima$5bc$
"Alain (74)"
Ce n'est pas un "défaut"...
Shell n'attend pas... c'est tout ;-)
Regarde et utilise ceci : http://www.mvps.org/accessfr/apis/api0004.htm
--
A+
Pierre (3stone) Access MVP
--------------------------------------
Une pour tous, tous pour une ;-)
http://users.skynet.be/mpfa/charte.htm
--------------------------------------
belles choses depuis longtemps!
Merci.
AE
"3stone" news:
John
"Alain (74)" news: