EXCEL und Netzwerk

 

Home
Nach oben

Last Update 20.07.2004

Copyright  2003
Ramses (C)

Verschiedene praktische, und weniger Einsatzmöglichkeiten, um mit EXCEL Netzwerke zu prüfen oder auch die ständig wechselnde IP-Adresse des eigenen Rechners zugemailt zu bekommen

 

  1. Stündliches prüfen der eigenen IP-Adresse mit Mail-Benachrichtigung
  2. Prüfen externer Rechner mittels einer Liste mit IP-Nummern

  3. Wer bin ich ?

  4. Temporäres Netzlaufwerk zuweisen wenn Laufwerksname nicht bekannt sondern nur der Server bzw. Freigabename

 


Stündliches prüfen der eigenen IP-Adresse.

Sollten Sie eine DSL-Flatrate haben und einen eigenen FTP-Server ohne eigene fixe IP-Adresse, wäre es doch ganz praktisch, wenn Sie bei einer Änderung über die neue Adresse informiert würden.,... oder ? :

 'Gehört zusammen für automatische Übermittlung der IP-Adresse
Sub Start_Call_IP()
 'Startet stündlich das nächste Makro
Application.OnTime Now() + TimeValue("01:00:00"), "Get_my_IP_and_send_Message"
End Sub


Sub Get_my_IP_and_send_Message()
'Hilfsvariable für Anzahl Datensätze
Dim Text1 As String
'Variablen für den Array nötig
Dim txtlines As Long, i As Long
'Für Office97 muss das Array "TextArr" als String definiert werden
'Entdeckt duch Gerd Z aus dem Herber Forum
Dim textArr As Variant, myCmd As Variant, myIp As String
Dim ReadFile As String
'Export der IP-Adress in ein txt File
'Den Namen und Pfad bitte anpassen
ReadFile = "C:\myIP.txt"
'Schliessen einer geöffneten Datei
Close #1
'Abfragen der eigenen IP-Adresse und Ausgabe in die Datei
myCmd = Shell("cmd.exe /C ipconfig > C:\myIP.txt")
'1. Öffnen der Datei
Open ReadFile For Input As #1
'Die anzahl ist nötig um die Grösse des Arrays zu deklarieren
'Zähler auf 0 setzen
txtlines = 0
Do While Not EOF(1)    ' Schleife bis Dateiende.
    Input #1, Text1    ' Hilfsvariable zum einlesen verwenden
    'Zähler hochzählen
    txtlines = txtlines + 1
Loop
'Schliessen der Datei weil Dateiende erreicht wurde
Close #1
'Erneutes Öffnen um zum Dateianfang zu kommen
Open ReadFile For Input As #1    ' Datei zum Einlesen öffnen.
'Array neu auf die Anzahl der Linien initialisieren
ReDim textArr(txtlines)
'Einlesen der Dateien in das Array
For i = 1 To txtlines
    Line Input #1, textArr(i)
Next i
Close #1
'IP String auslesen
For i = 1 To txtlines
    'Mit "IP-Adresse" beginnt der String mit der eigenen IP
    'Hast du noch eine zweite IP musst du den String anpassen
    If InStr(1, textArr(i), "IP-Adresse") Then
        myIp = Trim(Right(textArr(i), Len(textArr(i)) - InStrRev(textArr(i), ":", -1)))
    End If
Next i
'Vergleichen der IP's
If myPrivIp = "" Then
    'beim ersten Start
    myPrivIp = myIp
Else
    'Ip bereits vorhanden aber unterschiedlich
    If myPrivIp <> myIp Then
        myPrivIp = myIp
        ActiveWorkbook.SendMail "dein.name@dein.provider", "Neue IP:" & myIp
    End If
End If
'Rekursiver Aufruf um in einer Stunde erneut zu prüfen
Start_Call_IP
End Sub

 

Ist doch praktisch,... oder ;-)

Zurück


IP-Liste prüfen

Kann eine ganze Liste mit IP-Adressen testen und das ERgebnis in einer Tabelle ausgeben. Praktisch für WEB-Server oder sonstige Rechnerkontrolle im Netzwerk

Sub Check_IP_Number()
'by Ramses
'----
'Das ganze kann mit einer zusätzlichen Schleife aussenrum verwendet werden
'um zum Beispiel eine ganze Liste mit IP Adressen zui testen
'----
'Hilfsvariable für Anzahl Datensätze
Dim Text1 As String, ipAd As String
'Variablen für den Array nötig
Dim txtlines As Long, i As Long, n As Long, x As Long, wrC As Integer
'Für Office97 muss das Array "TextArr" als String definiert werden
'Entdeckt duch Gerd Z aus dem Herber Forum
Dim textArr As Variant, myCmd As Variant, myIp As String
Dim ReadFile As String
'Export der IP-Adress in ein txt File
'Den Namen und Pfad bitte anpassen
ReadFile = "C:\myIP.txt"
'Die zu pingenden Adressen beginnen in Zeile 2 der Spalte
For x = 2 To Cells(65536, 1).End(xlUp).Row
    'für einzelne Ping
    'myCmd = Shell("cmd.exe /C ping 192.168.0.2 > " & ReadFile)
    'Für Serienpings
    myCmd = Shell("cmd.exe /C ping " & Cells(x, 1).Text & " > " & ReadFile)
    'Warten um Datei schreiben zu können
    Application.Wait (Now + TimeValue("00:00:05"))
    'Erzeugt diese Einträge in der Datei
    '
    'Ping wird ausgefhrt fr 192.168.0.2 mit 32 Bytes Daten:
    'Antwort von 192.168.0.2: Bytes=32 Zeit=8ms TTL=128
    'Antwort von 192.168.0.2: Bytes=32 Zeit=2ms TTL=128
    'Antwort von 192.168.0.2: Bytes=32 Zeit=3ms TTL=128
    'Antwort von 192.168.0.2: Bytes=32 Zeit=3ms TTL=128
    '
    'Ping-Statistik fr 192.168.0.2:
    '
    'Pakete: Gesendet = 4, Empfangen = 4, Verloren = 0 (0% Verlust),
    'Ca. Zeitangaben in Millisek.:
    'Minimum = 2ms, Maximum = 8ms, Mittelwert = 4ms
    '------
    'Schliessen einer geöffneten Datei
    Close #1
    Open ReadFile For Input As #1
    'Die anzahl ist nötig um die Grösse des Arrays zu deklarieren
    'Zähler auf 0 setzen
    txtlines = 0
    Do While Not EOF(1)    ' Schleife bis Dateiende.
        Line Input #1, Text1    ' Hilfsvariable zum einlesen verwenden
        'Zähler hochzählen
        txtlines = txtlines + 1
    Loop
    'Schliessen der Datei weil Dateiende erreicht wurde
    Close #1
    'Erneutes Öffnen um zum Dateianfang zu kommen
    Open ReadFile For Input As #1    ' Datei zum Einlesen öffnen.
    'Array neu auf die Anzahl der Linien initialisieren
    ReDim textArr(txtlines)
    'Einlesen der Dateien in das Array
    For i = 1 To txtlines - 1
        Line Input #1, textArr(i)
    Next i
    Close #1
    'IP String auslesen
    For i = 1 To txtlines
        'Die IP-Adresse muss vorkommen
        If Left(textArr(i), 7) = "Antwort" And InStr(1, textArr(i), Cells(x, 1).Text) Then
            'zu füllende Spalten definieren
            wrC = 2
            ' in der übernächsten Zeile kommen die Antwortzeiten
            'Step 2 weil mit LineInput wohl noch ein Steuerzeichen importiert wird
            'das Zeilenschaltungen macht die nicht da sind
            For n = 0 To Step 2
                'in den nächsten 4 Zeilen kommen die Antwortzeiten
                'Ausgabe im Direktfenster
                'Debug.Print Trim(Right(textArr(i + n), Len(textArr(i + n)) - InStrRev(textArr(i + n), ":", -1)))
                'Ausgabe in die Zellen daneben
                Cells(x, wrC) = Trim(Right(textArr(i + n), Len(textArr(i + n)) - InStrRev(textArr(i + n), ":", -1)))
                wrC = wrC + 1
            Next n
        End If
    Next i
Next x
End Sub

 

Zurück


Wer bin ich ?

Sollte man eigentlich wissen,,.. in einem Netzwerk aber nicht immer selbstverständlich ;-)

  'Eigenes Kürzel definieren
Private Declare Function GCN Lib "kernel32" Alias "GetComputerNameA" (ByVal myPara As String, myLen As LongAs Long
Private Declare Function GUN Lib "advapi32.dll" Alias "GetUserNameA" (ByVal myPara As String, myLen As LongAs Long
'Standardeklarationen lauten sonst im allgemeinen
'Private Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long
'Private Declare Function GetUserNameA Lib "advapi32.dll" (ByVal lpBuffer As String, nSize As Long) As Long

'Prozeduren:
Public Function ActiveUserName() As String
'Benutzernamen auslesen
Dim AUN As String * 100
Dim AunLen As Byte
'100 Zeichen reichen in den meisten Fällen aus
AunLen = 100
If GUN(AUN, Len(AUN)) Then
    'Siehe Hinweis *
    ActiveUserName = Left(AUN, AunLen) 
Else
    ActiveUserName = "User can not be Identified"
End If
End Function
 

Public Function ActiveComputerName() As String
'Benutzernamen auslesen
Dim ACN As String * 100
Dim AcnLen As Byte
AcnLen = 100
If GCN(ACN, Len(ACN)) Then
  
 'Siehe Hinweis*
    ActiveComputerName = Left(ACN, AcnLen)
Else
    ActiveComputerName = "User can not be Identified"
End If
End Function


Sub wer_und_was_bin_ich()
Dim Qe As Byte
MsgBox ("Mein Rechner heisst" & ActiveComputerName)
MsgBox ("Aktuell angemeldeter User ist: " & ActiveUserName)
End Sub

-----------------------------------------------------------------------------

Hinweis

Das Problem das nun auftritt, ist, dass eine Überprüfung des Benutzernamens mit grosser Wahrscheinlichkeit/Sicherheit fehlschlägt.
Ihr Benutzer heisst "Uwe" und eine Überprüfung in der Art

If ActiveUserName = "Uwe" Then

schlägt fehl, obwohl im Debug.Fenster der richtige Name angezeigt wird. Das Problem liegt in der Dimensionierung der Variablen "AUN As String * 100"
Nach der Rückgabe aus der API-Funktion "GetUserNameA" wird die Variable mit sogenannten 0-Zeichen (ASCII 0) aufgefüllt bis der String eben die definierten 100 Zeichen enthält.
Testen können Sie dies, indem Sie am Punkt "If GUN...:" einen Haltepunkt setzen und mit dem Mauszeiger über die Variable AUN fahren. EXCEL zeigt Ihnen nun den Inhalt der Variablen "AUN" in einem Kommentarfeld an. Dieses wird in der Regel dann in etwa so aussehen:

"USERNAME
ù ù ù ù ù ù ù ù ù ù ù.......

Um diese 0-Zeichen zu eliminieren können Sie diese Funktion verwenden

Left(AUN, InStr(AUN, vbNullChar) - 1)

oder

Left(ACN, InStr(ACN, vbNullChar) - 1)

Mit "InStr" suchen Sie innerhalb des Strings AUN nach der Position des ersten Zeichen das diesem ASCII 0 Zeichen entspricht.
Dieses Zeichen können sie mit "vbNullChar" identifizieren.
Von dieser Positionsnummer subtrahieren  Sie 1 und haben den "reinen" Benutzernamen, bzw. den "reinen" Computernamen.

Alternativ geht's auch mit einer, etwas umständlichen ;-), eigenen Funktion der Sie die Variable "AUN" übergeben

Function PureName(tmpName As String)
Dim i
For i = 1 To 100
    Select Case UCase(Mid(tmpName, i, 1))
        Case vbNullChar
            'Hier wird die Position des
            'Zeichens ebenfalls gefunden
            Debug.Print "Pos: " & i
            PureName = Left(tmpName, i - 1)
            Exit For
    End Select
Next i
End Function

Sub wer_und_was_bin_ich()
MsgBox ("Mein Rechner ist" & PureName(ActiveComputerName) & PureName(ActiveUserName))
End Sub

Dann klappt's auch mit dem Vergleich ;-)

 

Zurück


Temporäres Netzlaufwerk

Sub Open_File_on_Not_Yet_Shared_Network_Drive()
'(C) by Ramses
'Öffnet den GetOpenFile-Dialog direkt auf eine Datei
'auf einem Netzlaufwerk dessen Server und Freigabe-Name zwar bekannt
'dessen LW-Bezeichnung jedoch nicht bekannt ist
'Kommt häufig vor in Firmen oder wenn manuelle
'Laufwerke gemappt werden, oder USB-Laufwerke
'verwendet werden, welche die normalen Laufwerksbezeichnungen
'verändern
Dim As Byte, x As Variant
Dim OrigDrive As String, FreeDrive As String
Dim defShare As String, defPath As String, defName As String
Dim openFile As String, defDrive As String
Dim shUsername As String, shPassword As String, shDomain As String
OrigDrive = Left(ThisWorkbook.FullName, 1)
'Backslash beachten !!!
'Zur Freigabe auf dem jeweiligen Rechner
defShare = "\\ServerName\Freigabename"
'Unterstruktur bis zur Datei
defPath = "\Unterordner\"
'Dateiname
defName = "Datei.xls"
'Username der auf die Netzwerkfreigabe zugreifen darf
shUsername = "Ramses"
'Passwort des berechtigten Users
shPassword = "Ramses"
'Eventuel Domäne in der der User bekannt ist
'wenn nicht aus der lokalen Domäne
shDomain = "Domäne"
If myFreeDrive = "Null" Then
    'normales öffnen zum Browsen
    'wenn kein Laufwerksname mehr zur Verfügung steht
    MsgBox "Datei kann nicht direkt angezeigt werden." & Chr$(13) & _
        "Die Datei: """ & defName & """ liegt auf: """ & defShare & defPath & """"
    'Alle Laufwerksbezeichnungen sind verwendet
    'Der User muss nun manuell auf die Datei browsen
    openFile = Application.GetOpenFilename(defName & " (*.xls), *.xls")
Else
    defDrive = myFreeDrive
    'Erstellen eines temporären Netzlaufwerkes ohne Username und Passwort
    x = Shell("cmd.exe /C net use " & defDrive & ": " & defShare)
    'Erstellen eines temporären Netzlaufwerkes mit Username und Passwort
    'Ohne Domäne
    'x = Shell("cmd.exe /C net use " & defDrive & ": " & defShare & _
        " " & shPassword & " /User:" & shUsername)
    'Mit fremder Domäne
    'x = Shell("cmd.exe /C net use " & defDrive & ": " & defShare & _
        " " & shPassword & " /User:" & shDomain & "\" & shUsername)
    'in das Verzeichnis wechseln
    ChDrive defDrive
    'in den Unterordner wechseln
    ChDir defDrive & ":" & defPath
    'dialog anzeigen
    openFile = Application.GetOpenFilename(defName & " (*.xls), *.xls")
    'Temporäres Laufwerk wieder löschen
    x = Shell("cmd.exe /C net use " & defDrive & " /Delete")
End If
'Die gewählte Datei öffnen
Workbooks.Open (openFile)
End Sub
 

Nächsten Freien Laufwerksbuchstaben ermitteln


Function myFreeDrive() As String
'(c) ramses
'Sucht den nächsten freien Laufwerksnamen
Dim myFSO As Object, myDrv As Object, drvCount, drvStr As String, vName As String, drvTyp As String
Dim drvmax As Byte, drvNum As Byte
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set drvCount = myFSO.drives
For Each myDrv In drvCount
    Select Case myDrv.drivetype
        'DriveType 3 sind netzlaufwerke
        'diese werden normalerweise von Z absteigend
        'gemappt. Relative Fehlerquelle !!!
        'Wenn sich der Admin nicht an die Convention hält :-)
        Case 3: drvmax = 90 - 1
        Case Else:
        'Val(Asc(myDrv.DriveLetter))
        'erstellt einen nummerischen Wert aus dem Buchstaben
            If drvNum = 0 Then
                drvNum = Val(Asc(myDrv.DriveLetter))
            End If
            If drvNum < Val(Asc(myDrv.DriveLetter)) Then
                drvNum = Val(Asc(myDrv.DriveLetter))
            End If
    End Select
Next
If drvmax <= drvNum + 1 Then
    myFreeDrive = "Null"
Else
    'Wandelt die entsprechende Nummer + 1
    'in einen zulässigen Laufwerksbuchstaben um
    myFreeDrive = Chr(drvNum + 1)
End If
End Function

Zurück