Err = 0
On Error Resume Next
'--- hier eine Aktion einfügen, die zu einem Fehler führt, wenn der Rechner nicht online ist
'--- z.B. eine Datei aus einem Netzwerklaufwerk öffnen oder mit "ChangeDrive"
'--- ein Netzwerklaufwerk einstellen
if err = 0 then
Msgbox "Rechner Online"
Else
Msgbox "Keine Online-Verbindung vorhanden"
End if
On error Goto 0
...
Gruß, Daniel
Err = 0
On Error Resume Next
'--- hier eine Aktion einfügen, die zu einem Fehler führt, wenn der Rechner nicht online ist
'--- z.B. eine Datei aus einem Netzwerklaufwerk öffnen oder mit "ChangeDrive"
'--- ein Netzwerklaufwerk einstellen
if err = 0 then
Msgbox "Rechner Online"
Else
Msgbox "Keine Online-Verbindung vorhanden"
End if
On error Goto 0
...
Gruß, Daniel
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As Long, _
ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long
Dim sConnType As String * 255
Sub sbStart()
Dim Ret As Long
Ret = InternetGetConnectedStateEx(Ret, sConnType, 254, 0)
If Ret = 1 Then
MsgBox "Du bist online!"
Else
MsgBox "Du bist nicht online!"
End If
End Sub
Hilfts?
Ciao
Thorsten
Option Explicit
Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
(ByVal HostName As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
wVersionRequired As Long, lpWSAData As WinSocketDataType) _
As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Const WS_VERSION_REQD As Long = &H101&
Private Type HostDeType
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
Private Type WinSocketDataType
wversion As Integer
wHighVersion As Integer
szDescription(0 To 128) As Byte
szSystemStatus(0 To 256) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type
Private Function InitSocketAPI() As Long
Dim Result As Integer
Dim SocketData As WinSocketDataType
InitSocketAPI = WSAStartup(WS_VERSION_REQD, SocketData)
End Function
Private Function Check_Connected(Name As String) As String
Dim HostDeAddress As Long
HostDeAddress = gethostbyname(Name)
If HostDeAddress = 0 Then
Check_Connected = "Keine Verbindung"
Else
Check_Connected = "Verbindung besteht"
End If
End Function
Sub Pruefe_Verbindung()
If InitSocketAPI = 0 Then
MsgBox Check_Connected("www.google.de")
Call WSACleanup
Else
MsgBox ("Socket Error! Die Verbindung kann nicht geprüft werden")
End If
End Sub
Gruß Tino