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

WMI sous VBA 2003

2 réponses
Avatar
GOWAP
Salutation,

savez-vous comment je peux utiliser sous VBA/Excel 2003 des appels a la WMI.

Comme je cherche depuis plusieurs mois a résouldre le problème du ping avec
la dll wsock2.dll sous VBA (XP2) qui retourne rien, meme pas une erreur,
j'ai regardé les WMI et trouver le code VBS ci-dessous.
Comme l'addapter pour qu'il soit en VBA ?

Merci,
GOWAP


-----------------------------------
Function Ping(strHost)
Dim colItems, objItem, intVal
Ping = False
Set colItems =
GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
("select * from Win32_PingStatus where address = '" & strHost & "'")
For Each objItem In colItems
If IsNull(objItem.StatusCode) Then
intVal = -1
Else
intval = objItem.StatusCode
End If
Ping = intVal
Exit For
Next
set colItems = Nothing
End Function

------------- routine qui ne fonctionne plus sous XP2------------------Sous
VBA/Excel 2003 -------
(extrait pris sur la page )

Private Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequested
As Integer, _
lpWSADATA As tagWSAData) As Integer
Private Declare Function WSACleanup Lib "WSOCK32" () As Integer

Function GetIPofHost(NomH As String) As Long
'GetIPofHost renvoie l'adresse IP type Long IPv4 d'une machine
'paramètre :
'NomH : nom DNS de la machine, exemple : www.google.com
Dim exeAPI As Long, i
Dim HostInfo As HOSTENT
Dim IPv4Adr As Long
Dim SockStart As Long
Dim SockInf As tagWSAData

Dim v

SockStart = WSAStartup(&H202, SockInf) 'ouvre un socket
exeAPI = gethostbyname(NomH) 'recupère le pointeur vers un
HOSTENT
SockStart = WSACleanup() 'ferme le socket

If exeAPI > 0 Then
'pour récupérer des valeurs dont on ne connais que le pointeur, on
utilise
'RtlMoveMemory
RtlMoveMemory HostInfo, exeAPI, ByVal (LenB(HostInfo))
RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList, 4
RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen
GetIPofHost = IPv4Adr
autrIP(0) = IPv4Adr

For i = 1 To 25 'on cherche jusqu'a 25 autres IP pour la même
machine
RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList + (i * 4), 4

If exeAPI <> 0 Then
RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen
autrIP(i) = IPv4Adr
Else
autrIPCnt = i
Exit For
End If

Next i

Else
'erreur : l'hôte n'a pas d'IP.
GetIPofHost = 0
End If

End Function

2 réponses

Avatar
martial collinet
Bonsoir,

Le code doit fonctionner en vba. Néanmoins, la classe Win32_PingStatus
n'existe que sous XP et supérieur si mes souvenirs sont bons.

Pour un ping, vas faire un tour sur mon site tu devrais trouver ce que tu
cherches.

Bon coding.
----------------------------------
martial collinet
http://martialcollinet.free.fr
----------------------------------



Salutation,

savez-vous comment je peux utiliser sous VBA/Excel 2003 des appels a la WMI.

Comme je cherche depuis plusieurs mois a résouldre le problème du ping avec
la dll wsock2.dll sous VBA (XP2) qui retourne rien, meme pas une erreur,
j'ai regardé les WMI et trouver le code VBS ci-dessous.
Comme l'addapter pour qu'il soit en VBA ?

Merci,
GOWAP


-----------------------------------
Function Ping(strHost)
Dim colItems, objItem, intVal
Ping = False
Set colItems =
GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
("select * from Win32_PingStatus where address = '" & strHost & "'")
For Each objItem In colItems
If IsNull(objItem.StatusCode) Then
intVal = -1
Else
intval = objItem.StatusCode
End If
Ping = intVal
Exit For
Next
set colItems = Nothing
End Function

------------- routine qui ne fonctionne plus sous XP2------------------Sous
VBA/Excel 2003 -------
(extrait pris sur la page )

Private Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequested
As Integer, _
lpWSADATA As tagWSAData) As Integer
Private Declare Function WSACleanup Lib "WSOCK32" () As Integer

Function GetIPofHost(NomH As String) As Long
'GetIPofHost renvoie l'adresse IP type Long IPv4 d'une machine
'paramètre :
'NomH : nom DNS de la machine, exemple : www.google.com
Dim exeAPI As Long, i
Dim HostInfo As HOSTENT
Dim IPv4Adr As Long
Dim SockStart As Long
Dim SockInf As tagWSAData

Dim v

SockStart = WSAStartup(&H202, SockInf) 'ouvre un socket
exeAPI = gethostbyname(NomH) 'recupère le pointeur vers un
HOSTENT
SockStart = WSACleanup() 'ferme le socket

If exeAPI > 0 Then
'pour récupérer des valeurs dont on ne connais que le pointeur, on
utilise
'RtlMoveMemory
RtlMoveMemory HostInfo, exeAPI, ByVal (LenB(HostInfo))
RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList, 4
RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen
GetIPofHost = IPv4Adr
autrIP(0) = IPv4Adr

For i = 1 To 25 'on cherche jusqu'a 25 autres IP pour la même
machine
RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList + (i * 4), 4

If exeAPI <> 0 Then
RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen
autrIP(i) = IPv4Adr
Else
autrIPCnt = i
Exit For
End If

Next i

Else
'erreur : l'hôte n'a pas d'IP.
GetIPofHost = 0
End If

End Function






Avatar
GOWAP
Peux-tu me faire un copie-coller de ton code en VBA qui exploite la WMI ?
Car j'ai bon chercher, rien passe.

Merci.


"martial collinet" <martialcollinet[nospam]@hotmail.com> a écrit dans le
message de news:
Bonsoir,

Le code doit fonctionner en vba. Néanmoins, la classe Win32_PingStatus
n'existe que sous XP et supérieur si mes souvenirs sont bons.

Pour un ping, vas faire un tour sur mon site tu devrais trouver ce que tu
cherches.

Bon coding.
----------------------------------
martial collinet
http://martialcollinet.free.fr
----------------------------------



Salutation,

savez-vous comment je peux utiliser sous VBA/Excel 2003 des appels a la
WMI.

Comme je cherche depuis plusieurs mois a résouldre le problème du ping
avec
la dll wsock2.dll sous VBA (XP2) qui retourne rien, meme pas une erreur,
j'ai regardé les WMI et trouver le code VBS ci-dessous.
Comme l'addapter pour qu'il soit en VBA ?

Merci,
GOWAP


-----------------------------------
Function Ping(strHost)
Dim colItems, objItem, intVal
Ping = False
Set colItems >> GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
("select * from Win32_PingStatus where address = '" & strHost &
"'")
For Each objItem In colItems
If IsNull(objItem.StatusCode) Then
intVal = -1
Else
intval = objItem.StatusCode
End If
Ping = intVal
Exit For
Next
set colItems = Nothing
End Function

------------- routine qui ne fonctionne plus sous
XP2------------------Sous
VBA/Excel 2003 -------
(extrait pris sur la page )

Private Declare Function WSAStartup Lib "WSOCK32" (ByVal
wVersionRequested
As Integer, _
lpWSADATA As tagWSAData) As Integer
Private Declare Function WSACleanup Lib "WSOCK32" () As Integer

Function GetIPofHost(NomH As String) As Long
'GetIPofHost renvoie l'adresse IP type Long IPv4 d'une machine
'paramètre :
'NomH : nom DNS de la machine, exemple : www.google.com
Dim exeAPI As Long, i
Dim HostInfo As HOSTENT
Dim IPv4Adr As Long
Dim SockStart As Long
Dim SockInf As tagWSAData

Dim v

SockStart = WSAStartup(&H202, SockInf) 'ouvre un socket
exeAPI = gethostbyname(NomH) 'recupère le pointeur vers un
HOSTENT
SockStart = WSACleanup() 'ferme le socket

If exeAPI > 0 Then
'pour récupérer des valeurs dont on ne connais que le pointeur,
on
utilise
'RtlMoveMemory
RtlMoveMemory HostInfo, exeAPI, ByVal (LenB(HostInfo))
RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList, 4
RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen
GetIPofHost = IPv4Adr
autrIP(0) = IPv4Adr

For i = 1 To 25 'on cherche jusqu'a 25 autres IP pour la même
machine
RtlMoveMemory exeAPI, ByVal HostInfo.hAddrList + (i * 4), 4

If exeAPI <> 0 Then
RtlMoveMemory IPv4Adr, ByVal exeAPI, HostInfo.hLen
autrIP(i) = IPv4Adr
Else
autrIPCnt = i
Exit For
End If

Next i

Else
'erreur : l'hôte n'a pas d'IP.
GetIPofHost = 0
End If

End Function