Macronun Çalıştığı Dosyadaki Pc IP numarasını ve Pc adını almak

[ASMET67]

Ortak Bir Server'a kopyalanan ve herkesin bu servera bağlanıp Lokal Pc sinden kullanılan Excel dosyam var bu dosya kayıt işlemlerini SQL servera yapmaktadır.

Benim sorunun Macrolu dosya ile yapılan işlemlerin hangi bilgisayardan hangi IP ile kayıt edildiğini Datada tutmak gerekiyor. Dosyanın çalıştırıldığı Pc nin IP, Pc Adı ve oturum açan kullanıcı bilgilerini açılış esnasında veya kayıt butonu altında nasıl alabilirim.

 

[Haluk]

Forumda arama yapın, benzer örnekler vardı.

.

 

[ASMET67]

Ip no alma diye yaptım bulamadım

 

[u.L.a.s]

https://www.excel.web.tr/threads/ip-numarasi-goesterecek-makro.1156/

 

[Haluk]

Lokal IP adresi için;

Sub Get_Local_IP()
    strMsg = ""
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set IPConfigSet = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled = 'True'")
    For Each IPConfig In IPConfigSet
        If Not IsNull(IPConfig.IPAddress) Then
            For i = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
                If Not InStr(IPConfig.IPAddress(i), ":") > 0 Then
                    strMsg = strMsg & IPConfig.IPAddress(i) & vbCrLf
                End If
            Next
        End If
    Next
    MsgBox strMsg
End Sub

Public IP adresi için;

Sub Public_IP()
    'Haluk - 03/09/2018
    Dim objHttp As Object
    Set objHttp = CreateObject("MSXML2.XMLHTTP")
    objHttp.Open "GET", "http://myip.dnsomatic.com", False
    objHttp.Send
    MsgBox objHttp.ResponseText
    Set objHttp = Nothing
End Sub

PC adı için;

Sub PC()
    Dim MyMsg As String, oSystem As Object, Item As Object
    Set oSystem = GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
    For Each Item In oSystem
        MsgBox Item.Name & vbCrLf
    Next
    Set oSystem = Nothing
End Sub

Kullanıcı adı için;

Sub UserName()
    MsgBox Environ("Username")
End Sub

.

 

[askm]

Kolay gelsin. Makro ile ağ üzerindeki bilgisayarların da ip adresi ve kullanıcı adları gibi bilgileri alma imkanı var mı?

 

[s.savas]

Lokal IP adresi için;

Sub Get_Local_IP()
    strMsg = ""
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set IPConfigSet = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled = 'True'")
    For Each IPConfig In IPConfigSet
        If Not IsNull(IPConfig.IPAddress) Then
            For i = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
                If Not InStr(IPConfig.IPAddress(i), ":") > 0 Then
                    strMsg = strMsg & IPConfig.IPAddress(i) & vbCrLf
                End If
            Next
        End If
    Next
    MsgBox strMsg
End Sub

Public IP adresi için;

Sub Public_IP()
    'Haluk - 03/09/2018
    Dim objHttp As Object
    Set objHttp = CreateObject("MSXML2.XMLHTTP")
    objHttp.Open "GET", "http://myip.dnsomatic.com", False
    objHttp.Send
    MsgBox objHttp.ResponseText
    Set objHttp = Nothing
End Sub

PC adı için;

Sub PC()
    Dim MyMsg As String, oSystem As Object, Item As Object
    Set oSystem = GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
    For Each Item In oSystem
        MsgBox Item.Name & vbCrLf
    Next
    Set oSystem = Nothing
End Sub

Kullanıcı adı için;

Sub UserName()
    MsgBox Environ("Username")
End Sub

.

Haluk hocam öncelikle teşekkürler.
Sub Get_Local_IP makrosu ile alınan sonucu userformda bulunan bir label etiketinde nasıl gösteririz.

 

[Haluk]

Private Sub UserForm_Initialize()
    strMsg = ""
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set IPConfigSet = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled = 'True'")
    For Each IPConfig In IPConfigSet
        If Not IsNull(IPConfig.IPAddress) Then
            For i = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
                If Not InStr(IPConfig.IPAddress(i), ":") > 0 Then
                    strMsg = strMsg & IPConfig.IPAddress(i) & vbCrLf
                End If
            Next
        End If
    Next
    Label1 = strMsg
End Sub

.

 

[Haluk]

Yukarıda 5 No'lu mesajdaki Public_IP isimli kodda kullanılan sunucu aktif olmadığı için, başka bir alternatif aşağıdadır.

Burada, sunucudan JSon formatında dönen cevap, Regular Expressions tekniği kullanılarak, "Public IP" adresi bulunmaktadır.

Sub Public_IP_2()
    'Haluk - 04/07/2019
    'E-posta: sa4truss@gmail.com
    '
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim regExp As Object, RetVal As Object
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    strURL = "https://api.myip.com"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    
    HTMLcode = objHTTP.responseText
    
    Set regExp = CreateObject("VBScript.RegExp")
    
    regExp.IgnoreCase = True
    regExp.Global = True
    
    regExp.Pattern = """ip"":""(.+)"",""country"""
    
    If regExp.Test(HTMLcode) Then
        Set RetVal = regExp.Execute(HTMLcode)
        MsgBox "IP adresi: " & RetVal(0).Submatches(0)
    End If
    
    Set RetVal = Nothing
    Set regExp = Nothing
    Set objHTTP = Nothing
End Sub

.

 

[Believing]

Yukarıda 5 No'lu mesajdaki Public_IP isimli kodda kullanılan sunucu aktif olmadığı için, başka bir alternatif aşağıdadır.
Burada, sunucudan JSon formatında dönen cevap, Regular Expressions tekniği kullanılarak, "Public IP" adresi bulunmaktadır.

Sub Public_IP_2()
    'Haluk - 04/07/2019
    'E-posta: sa4truss@gmail.com
    '
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim regExp As Object, RetVal As Object
  
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
  
    strURL = "https://api.myip.com"
  
    objHTTP.Open "GET", strURL, False
    objHTTP.send
  
    HTMLcode = objHTTP.responseText
  
    Set regExp = CreateObject("VBScript.RegExp")
  
    regExp.IgnoreCase = True
    regExp.Global = True
  
    regExp.Pattern = """ip"":""(.+)"",""country"""
  
    If regExp.Test(HTMLcode) Then
        Set RetVal = regExp.Execute(HTMLcode)
        MsgBox "IP adresi: " & RetVal(0).Submatches(0)
    End If
  
    Set RetVal = Nothing
    Set regExp = Nothing
    Set objHTTP = Nothing
End Sub

.

Sayın Haluk Bey,

Sorguladığımız Public ip adresini sayfa açılırken otomatik olarak, "Control" isimli sayfasının "A2" hücresine yazdırmak için, yukarıda vermiş olduğunuz kodları nasıl revize etmeliyim.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[k0081]

@Haluk;

Merhaba hocam,


Bu kodda (#9) değişiklik yaparak ağdaki telefonun IP no sunu öğrenebilirmiyiz?

 

[k0081]

@Haluk;

Merhaba hocam,


Bu kodda (#9) değişiklik yaparak ağdaki telefonun IP no sunu öğrenebilirmiyiz?

yardımcı olması açısından, Mac adresi : 00:6d:52:7e:c8:ff

 

[Haluk]

Mobil cihazlarda VBA kodu çalışmaz.

Çok gerekiyorsa, Google Sheets'de Javascript ile alınabilir....

.

 

[k0081]

@Haluk

Hocam ; kodu excel üzerinden çalıştırmayı planlıyorum. bu şekilde alınamazmı acaba ?

Modem sayfasına girdiğimde burada görünüyor.

 

[Haluk]

Bilgisayarla internete telefonu modem olarak kullanarak mı çıkıyorsunuz?

.

 

[k0081]

Hayır.
Modeme hem telefon hemde Bilgisayar wifi üzerinden bağlı.

 

[Haluk]

O zaman telefon ve Bilgisayar ayrı ayrı IP almaz, internete çıkış noktası olan modemin aldığı IP adresini her 2 cihaz da kullanır.

.

 

[k0081]

Telefonda daki IP son iki rakamı hatta son rakamı Bilgisayardakinden Farklı.

Telefon ... ... ... 34
Bilgisayar ... ... ... 35

 

[Haluk]

Çok tuhaf ..... olmaması gereken birşey !

.

 

[k0081]

Hocam TV deki ip de farklı. hiçbiri aynı değilki.. yani her cihaz için ayrı bir ip atanıyor diye biliyorum ama.. yanlış mı?