Menu


Główna
Kurs:
Wstęp

Edytor

Pierwszy program

Instrukcje warunkowe

Pętle

Przydatne makra:

 Sheet delete

Nie zapisuj

Iloczyn macierzy

IP - ping

 Makro:IP -ping

Makro testujące czas opóźnień z serwerów o adresach IP podanych w kolejnych kolumnach. Jest ono uruchamiane co 1 min. Podczas "działania" jest tworzony "w locie" plik .bat uruchamiający polecenie ping. Wyniki zapisywane są w odpowiednich komórkach.

 Private Function OpoznienieSrednie() As Integer

'funkcja zwraca sredni czas opóźnienia
'odczytany z pliku c:\pinginfo.txt

Dim fso As Object, plik As Object
Dim strSciezka As String
Dim calyPlik
Dim strlinia As String
Dim CzasOpoznienia(0 To 2) As String
Dim tempZnak As String
Dim i, j As Integer

strSciezka = "c:\pinginfo.txt" 'sciezka do pliku z efektem działania polecenia ping

On Error GoTo Blad 'w przypadku błędu zwróci -1

Set fso = CreateObject("Scripting.FileSystemObject")

If (fso.FileExists(strSciezka)) Then

Set plik = fso.OpenTextFile(strSciezka, 1) 'otwarcie do odczytu

i = 1 'start licznika linii

Do While Not plik.AtEndOfStream
strlinia = plik.ReadLine
If i = 23 Then
Exit Do
End If
i = i + 1
Loop
plik.Close
Else
'MsgBox "Plik nie istnieje"
OpoznienieSrednie = -1 'funkcja zwróci -1 gdy nie ma pliku w podanej lokalizacji
Exit Function ' namiastka obsługi błędu
End If

i = 1: j = 0

Do While (i <= Len(strlinia))
tempZnak = Mid(strlinia, i, 1)
If IsNumeric(tempZnak) Then
CzasOpoznienia(j) = CzasOpoznienia(j) + tempZnak
If Not (IsNumeric(Mid(strlinia, (i + 1), 1))) Then
j = j + 1
End If
End If

i = i + 1
Loop

OpoznienieSrednie = CInt(CzasOpoznienia(2))
Exit Function

Blad:
'w przypadku błędu funkcja zwróci -1
OpoznienieSrednie = -1
End Function

Private Sub SprawdzPolaczenie(nrIP As String)

'rezultatem działania procedury jest plik w rezultatem uruchomienia polecenia ping

Dim dblTest As Double

Dim startTime As Date
Dim lsekund As Date

Dim fso As Object, plikbat As Object
Dim strlinia As String

'tworzenie pliku wsadowego w zależności od żadanego IP
Set fso = CreateObject("Scripting.FileSystemObject")
Set plikbat = fso.CreateTextFile("c:\pingBAT.bat", True)
plikbat.WriteLine ("ping " & nrIP & " > c:\pinginfo.txt")
plikbat.Close

dblTest = Shell("c:\pingBAT.bat", vbHide) 'uruchomienie wsadu

'opóźniacz - 6 sek:
startTime = Time()
Do While (lsekund <= TimeValue("00:00:06"))
lsekund = Time() - startTime
Loop

End Sub

Public Sub DodajWiersz()
Dim nrWiersza As Integer
Dim wiersz As Integer
Dim curKol As Integer
Dim curIP As String

wiersz = 3
Do While (Worksheets("Arkusz1").Cells(wiersz, 1).Value <> "")
'podbno mało eleganckie - ale działa
wiersz = wiersz + 1
Loop

Worksheets("Arkusz1").Cells(wiersz, 1).Value = Date 'kolumna A
Worksheets("Arkusz1").Cells(wiersz, 2).Value = Time() 'kolumna B

curKol = 3 'rozpoczęcie sprawdzania od trzeciej kolumny
'sprawdzenie czy w kolejnych kolumnach w 3 wierszu jest jakiś adres IP
Do While (Worksheets("Arkusz1").Cells(3, curKol).Value <> "")
'bieżące IP:
curIP = Worksheets("Arkusz1").Cells(3, curKol).Value
Call SprawdzPolaczenie(curIP)
'wstawienie czasu opoznienia dla IP odczytanego z kolumny
Worksheets("Arkusz1").Cells(wiersz, curKol).Value = OpoznienieSrednie()
curKol = curKol + 1
Loop

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strCzas As Variant
Dim strSekundy, strMinuty As String
Static godzina As String

If Target.AddressLocal(RowAbsolute:=False) = "$A1" _
And chkRun.Value Then

strCzas = Split(Worksheets("Arkusz1").Range("A1").Value, ":")
strMinuty = strCzas(1)

'uruchomienie o każdej pełnej godzinie, czyli:
'If strMinuty = "00" And Target.Value <> godzina Then
'lub co minutkę (teraz ta instrukcja działa):
If Target.Value <> godzina Then 'żeby działało co godzinę tą linię trzeba wywalić
'i odhaczyć z komentarza poprzednie If...
Call DodajWiersz
godzina = CStr(Format(Time, "hh:mm"))
ThisWorkbook.Save
End If

End If

End Sub

Linki
VBA:

VBA Mania

Anhtony VBA

 Shmitti's Vba

 Excel Macro

Programy VBA
Inne: