Excel makroda Cmd yazma okuma

[mustafaayd]

Merhabalar,

Excel makroda Süntünlara yazdıdım örnek A1 sütununda "ping 10.25.25.25 -t " komutunu yazarak çıkan sonuca göre b1 komutunu kırmızı veya yeşile boyamasını istiyorum .
yeşil yanması için cmd ekranında aşağıdakinı okuması gereklidir.
Pinging 10.131.10.13 with 32 bytes of data:
Reply from 10.25.10.13: bytes=32 time=5ms TTL=128
Reply from 10.25.10.13: bytes=32 time<1ms TTL=128
Reply from 10.25.10.13: bytes=32 time=1ms TTL=128
Reply from 10.25.10.13: bytes=32 time<1ms TTL=128
Kırmızı renk için
Pinging 10.10.100.10 with 32 bytes of data:
Request timed out.

Bu şekilde excel makrosunu kullanarak yazma ve okuma yaptırabilirmiyim.

 

[veyselemre]

Ping IP Address with VBA code and return results in Excel

I have some visual basic code (see below) that tests an IP connection in column B (of an excel spreadsheet) and puts whether or not it is connected or un-reachable in column c, I was just wondering...

stackoverflow.com

Sub GetIPStatus()

    Dim Cell As Range
    Dim ipRng As Range, RngEnd As Range
    Dim Result As String
    Dim Wks As Worksheet

    Set Wks = Worksheets("Sheet1")

    Set ipRng = Wks.Range("A1")
    Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
    Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))

    For Each Cell In ipRng
        Result = GetPingResult(Cell)
        If Result = "Connected" Then
            Cell.Offset(0, 1).Interior.Color = vbGreen
        Else
            Cell.Offset(0, 1).Interior.Color = vbRed
        End If
    Next Cell

End Sub

Function GetPingResult(Host)

    Dim objPing As Object
    Dim objStatus As Object
    Dim strResult As String

    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
                  ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")

    For Each objStatus In objPing
        Select Case objStatus.StatusCode
            Case 0: strResult = "Connected"
            Case 11001: strResult = "Buffer too small"
            Case 11002: strResult = "Destination net unreachable"
            Case 11003: strResult = "Destination host unreachable"
            Case 11004: strResult = "Destination protocol unreachable"
            Case 11005: strResult = "Destination port unreachable"
            Case 11006: strResult = "No resources"
            Case 11007: strResult = "Bad option"
            Case 11008: strResult = "Hardware error"
            Case 11009: strResult = "Packet too big"
            Case 11010: strResult = "Request timed out"
            Case 11011: strResult = "Bad request"
            Case 11012: strResult = "Bad route"
            Case 11013: strResult = "Time-To-Live (TTL) expired transit"
            Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
            Case 11015: strResult = "Parameter problem"
            Case 11016: strResult = "Source quench"
            Case 11017: strResult = "Option too big"
            Case 11018: strResult = "Bad destination"
            Case 11032: strResult = "Negotiating IPSEC"
            Case 11050: strResult = "General failure"
            Case Else: strResult = "Unknown host"
        End Select
        GetPingResult = strResult
    Next

    Set objPing = Nothing

End Function

 

[mustafaayd]

Bilgilendirme için teşekkür ederim ama 700 satırlık bir satır var be bu sürekli çalışacaktır sürekli cmd ekranındaki pingleri okuyacaktır ona göre yeşil veya kırmızı yanıcak sonra kırmızı olanları mail attıracagım

 

[Asri]

Alternatif;

Bu bat dosyasını kullanabilirsiniz.
Aktif olanlarında kaydını almak için REM i silin.

liste.txt dosyasına IP adreslerini alt alta yazın.

Kaynak:https://groups.google.com/g/alt.msdos.batch.nt/c/L-v4bpbyo1Q?pli=1

set LogFile=aktifdegil.txt
If exist "%LogFile%" Del "%LogFile%"
for /f "delims=, tokens=1*" %%a in ('type liste.txt') do (
ping -n 1 %%a|find "TTL">nul
if not errorlevel 1 (
rem echo %%a AKTIF>>%LogFile%
) else (
echo %%a AKTIF DEGIL>>%LogFile%)
)

 

[mustafaayd]

Teşekkürle tamamlandı