• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan ASMET67
  • Başlangıç tarihi Başlangıç tarihi
A

ASMET67

Altın Üye
Katılım
8 Haziran 2007
Mesajlar
410
Excel Vers. ve Dili
Excel 2016
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.
 
Forumda arama yapın, benzer örnekler vardı.

.
 
Ip no alma diye yaptım bulamadım
 
Lokal IP adresi için;

Kod: 
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;

Kod: 
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;

Kod: 
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;

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

.
 
Son düzenleme:
Kolay gelsin. Makro ile ağ üzerindeki bilgisayarların da ip adresi ve kullanıcı adları gibi bilgileri alma imkanı var mı?
 
Haluk' Alıntı:
Lokal IP adresi için;

Kod: 
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;

Kod: 
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;

Kod: 
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;

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

.
Genişletmek için tıkla ...
Haluk hocam öncelikle teşekkürler.
Sub Get_Local_IP makrosu ile alınan sonucu userformda bulunan bir label etiketinde nasıl gösteririz.
 
Kod: 
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


.
 
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.


Kod: 
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


.
 
Haluk' Alıntı:
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.


Kod: 
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


.
Genişletmek için tıkla ...


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Ü
 
@Haluk;

Merhaba hocam,


Bu kodda (#9) değişiklik yaparak ağdaki telefonun IP no sunu öğrenebilirmiyiz?
 
Mobil cihazlarda VBA kodu çalışmaz.

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

.
 
@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.
 
Bilgisayarla internete telefonu modem olarak kullanarak mı çıkıyorsunuz?

.
 
Hayır.
Modeme hem telefon hemde Bilgisayar wifi üzerinden bağlı.
 
O zaman telefon ve Bilgisayar ayrı ayrı IP almaz, internete çıkış noktası olan modemin aldığı IP adresini her 2 cihaz da kullanır.

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

Telefon ... ... ... 34
Bilgisayar ... ... ... 35
 
Çok tuhaf ..... olmaması gereken birşey !

.
 
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ı?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst