WMI (Windows Management Instrumentation) ile OS Bilgileri

Excel VBA açık kodlarını buradan izleyebilir ve paylaşabilirsiniz.

WMI (Windows Management Instrumentation) ile OS Bilgileri

İleti#1)  Haldun Alay » 21 Oca 2009 11:31

WMI arayüzü üzerinden İşletim Sistemi bilgilerini sorgulama.

Kod: Tümünü seç
Sub IsletimSistemiBilgileri()
    Dim objWMIService, objItem, colItems, strComputer, item
    Dim Sht As Worksheet
    Dim Rng As Range
    strComputer = "."
    Set Sht = ThisWorkbook.Worksheets.Add
    Set Rng = Sht.Range("A1")
    Rng.Offset(0, 1).EntireColumn.HorizontalAlignment = xlLeft
    With Rng.Resize(1, 2)
        .Value = Array("Açıklama", "Değer")
        .Font.Bold = True
    End With
    Set Rng = Rng.Offset(1, 0)
    Rng.Select
    ActiveWindow.FreezePanes = True
    Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    For Each objItem In colItems
        For Each item In objItem.Properties_
            If TypeName(item.Value) <> "Variant()" Then
                Rng.Resize(1, 2).Value = Array(item.Name, item.Value)
                Set Rng = Rng.Offset(1, 0)
            End If
        Next
    Next
    Rng.Parent.Cells.Columns.AutoFit
    Set objWMIService = Nothing
    Set colItems = Nothing
End Sub
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

WMI Bilgisayardaki Mantıksal Sürücü Bilgileri

İleti#2)  Haldun Alay » 21 Oca 2009 11:51

Kod: Tümünü seç
Sub MantiksalDiskSuruculeri()
    On Error Resume Next
    Dim objWMI
    Dim LogicalDisks
    Dim LogicalDisk
    Dim Property
    Dim sht As Worksheet
    Dim Rng As Range, sRng As Range
    Dim strComputer As String
    strComputer = "."
    Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set LogicalDisks = objWMI.InstancesOf("Win32_LogicalDisk")

    Set sht = ThisWorkbook.Worksheets.Add
    Set Rng = sht.Range("a1")
    Set sRng = Rng
    Rng.Parent.Cells.HorizontalAlignment = xlLeft
    For Each LogicalDisk In LogicalDisks
        ReDim p_vntTmp(0 To 1, 0 To 6) As String

        For Each Property In LogicalDisk.Properties_
            With Property
                If sRng.Column = 1 Then
                    Rng.Resize(1, 2).Value = Array(Property.Name, Property.Value)
                Else
                    Rng.Value = Property.Value
                End If
                Set Rng = Rng.Offset(1, 0)
            End With

        Next
        If sRng.Column = 1 Then
            Set Rng = sRng.Offset(0, 2)
            Set sRng = Rng
        Else
            Set Rng = sRng.Offset(0, 1)
            Set sRng = Rng
        End If
    Next
    Rng.Parent.Cells.EntireColumn.AutoFit
End Sub
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

WMI ile Yazıcı Bilgileri

İleti#3)  Haldun Alay » 21 Oca 2009 11:59

Kod: Tümünü seç
Sub YaziciBilgileri()
    On Error Resume Next
    Dim objWMI
    Dim objUpdates
    Dim objUpdate
    Dim Property
    Dim sht As Worksheet
    Dim Rng As Range, sRng As Range
    Dim strComputer As String
    strComputer = "."
    Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set objPrinters = objWMI.InstancesOf("Win32_PrinterConfiguration")

    Set sht = ThisWorkbook.Worksheets.Add
    Set Rng = sht.Range("a1")
    Set sRng = Rng
    Rng.Parent.Cells.HorizontalAlignment = xlLeft
    For Each objPrinter In objPrinters
         For Each Property In objPrinter.Properties_
            With Property
                If sRng.Column = 1 Then
                    Rng.Resize(1, 2).Value = Array(Property.Name, Property.Value)
                Else
                    Rng.Value = Property.Value
                End If
                Set Rng = Rng.Offset(1, 0)
            End With

        Next
        If sRng.Column = 1 Then
            Set Rng = sRng.Offset(0, 2)
            Set sRng = Rng
        Else
            Set Rng = sRng.Offset(0, 1)
            Set sRng = Rng
        End If
    Next
    Rng.Parent.Cells.EntireColumn.AutoFit
End Sub
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

WMI Windows Güncelleme Bilgileri

İleti#4)  Haldun Alay » 21 Oca 2009 12:19

Kod: Tümünü seç
Sub IsletimSistemiGuncellemeleri()
    Dim strComputer As String
    Dim objWMI As Object, objUpdate As Object, objUpdates As Object
    Dim Rng As Range, Rngs As Range
    strComputer = "."

    Set objWMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set objUpdates = objWMI.ExecQuery("Select * from Win32_QuickFixEngineering")
    Set sht = ThisWorkbook.Worksheets.Add
    Set Rng = sht.Range("a1")
    Set sRng = Rng
    Rng.Parent.Cells.HorizontalAlignment = xlLeft
    For Each objUpdate In objUpdates
        ReDim p_vntTmp(0 To 1, 0 To 6) As String

        For Each Property In objUpdate.Properties_
            With Property
                If sRng.Row = 1 Then
                    Rng.Resize(2, 1).Value = WorksheetFunction.Transpose(Array(Property.Name, IIf(IsNull(Property.Value), "", Property.Value)))
                Else
                    Rng.Value = Property.Value
                End If
                Set Rng = Rng.Offset(0, 1)
            End With

        Next
        If sRng.Row = 1 Then
            Set Rng = sRng.Offset(2, 0)
            Set sRng = Rng
        Else
            Set Rng = sRng.Offset(1, 0)
            Set sRng = Rng
        End If
    Next
    Rng.Parent.Cells.EntireColumn.AutoFit


End Sub
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

WMI (Windows Management Instrumentation) ile OS Bilgileri

İleti#5)  Erkan Akayay » 21 Oca 2009 12:20

Haldun Hocam şkşk Şahsi kimlik bilgilerimiz kalsın :)
Sorularınızı düzgün bir Türkçe ile, detay vererek ve örnek dosyayla destekleyerek sorunuz.
Örnek dosyalarınızda Application.Visible veya hide gibi sayfa gizlemelerini iptal ediniz.
Kullanıcı avatarı
Erkan Akayay
Site Dostu
 
Kayıt: 20 Ağu 2008 11:59
Konum: YALOVA
Meslek: Bilgi İşlem
Yaş: 50
İleti: 4065
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

WMI (Windows Management Instrumentation) ile OS Bilgileri

İleti#6)  Haldun Alay » 21 Oca 2009 12:22

Erkan Akayay yazdı:Haldun Hocam şkşk Şahsi kimlik bilgilerimiz kalsın :)


Tamam o zaman kimlik bilgisi sorgulamayı göndermeyeyim. hehe hehe hehe hehe hehe
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

WMI (Windows Management Instrumentation) ile OS Bilgileri

İleti#7)  Tarkan VURAL » 21 Oca 2009 12:28

Teşekkürler Haldun bey, şkşk şkşk örneklerimiz git gide zenginleşiyor. --)(
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ?
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 18:27
Konum: @tarkanvural73
Meslek: LUU, Database Expert, Senior Software Specialist, Developer
Yaş: 46
İleti: 27311
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

WMI ile Bilgisayarda Kayıtlı Servisler

İleti#8)  Haldun Alay » 21 Oca 2009 12:38

Kod: Tümünü seç
Sub KayitliHizmetler()
    On Error Resume Next
    Dim objWMI
    Dim objServices
    Dim objService
    Dim Property
    Dim sht As Worksheet
    Dim Rng As Range, sRng As Range
    Dim strComputer As String
    strComputer = "."
    Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set objServices = objWMI.InstancesOf("Win32_Service")

    Set sht = ThisWorkbook.Worksheets.Add
    Set Rng = sht.Range("a1")
    Set sRng = Rng
    Rng.Parent.Cells.HorizontalAlignment = xlLeft
    For Each objService In objServices

        For Each Property In objService.Properties_
            With Property
                If sRng.Row = 1 Then
                    Rng.Resize(2, 1).Value = WorksheetFunction.Transpose(Array(Property.Name, IIf(IsNull(Property.Value), "", Property.Value)))
                Else
                    Rng.Value = Property.Value
                End If
                Set Rng = Rng.Offset(0, 1)
            End With

        Next
        If sRng.Row = 1 Then
            Set Rng = sRng.Offset(2, 0)
            Set sRng = Rng
        Else
            Set Rng = sRng.Offset(1, 0)
            Set sRng = Rng
        End If
    Next
    With Rng.Parent.Cells
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
End Sub
En son Haldun Alay tarafından, 21 Oca 2009 13:52 tarihinde değiştirildi, toplamda 1 değişiklik yapıldı.
Sebep: Eksik kod düzeltildi
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

WMI ile Bilgisayar Bilgileri

İleti#9)  Haldun Alay » 21 Oca 2009 13:05

Kod: Tümünü seç
Sub BilgisayarBilgileri()
    Dim objWMIService, objItem, colItems, strComputer, item
    Dim sht As Worksheet
    Dim Rng As Range
    strComputer = "."
    Set sht = ThisWorkbook.Worksheets.Add
    Set Rng = sht.Range("A1")
    Rng.Offset(0, 1).EntireColumn.HorizontalAlignment = xlLeft
    With Rng.Resize(1, 2)
        .Value = Array("Açıklama", "Değer")
        .Font.Bold = True
    End With
    Set Rng = Rng.Offset(1, 0)
    Rng.Select
    ActiveWindow.FreezePanes = True
    Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    For Each objItem In colItems
        For Each item In objItem.Properties_
            If TypeName(item.Value) <> "Variant()" Then
                Rng.Resize(1, 2).Value = Array(item.Name, item.Value)
                Set Rng = Rng.Offset(1, 0)
            End If
        Next
    Next
    Rng.Parent.Cells.Columns.AutoFit
    Set objWMIService = Nothing
    Set colItems = Nothing
End Sub
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

WMI ile Bilgisayarda Tanımlı Kullanıcılar

İleti#10)  Haldun Alay » 21 Oca 2009 13:53

Kod: Tümünü seç
Sub TanimliKullanicilar()
    On Error Resume Next
    Dim objWMI
    Dim objUsers
    Dim objUser
    Dim Property
    Dim sht As Worksheet
    Dim Rng As Range, sRng As Range
    Dim strComputer As String
    strComputer = "."
    Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set objUsers = objWMI.InstancesOf("Win32_UserAccount")

    Set sht = ThisWorkbook.Worksheets.Add
    Set Rng = sht.Range("a1")
    Set sRng = Rng
    Rng.Parent.Cells.HorizontalAlignment = xlLeft
    For Each objUser In objUsers

        For Each Property In objUser.Properties_
            With Property
                If sRng.Row = 1 Then
                    Rng.Resize(2, 1).Value = WorksheetFunction.Transpose(Array(Property.Name, IIf(IsNull(Property.Value), "", Property.Value)))
                Else
                    Rng.Value = Property.Value
                End If
                Set Rng = Rng.Offset(0, 1)
            End With

        Next
        If sRng.Row = 1 Then
            Set Rng = sRng.Offset(2, 0)
            Set sRng = Rng
        Else
            Set Rng = sRng.Offset(1, 0)
            Set sRng = Rng
        End If
    Next
    With Rng.Parent.Cells
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
End Sub
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

WMI ile Ağ Bağdaştırıcıları Listesi

İleti#11)  Haldun Alay » 21 Oca 2009 14:30

Kod: Tümünü seç
Sub AgBagdastiricilari()
    On Error Resume Next
    Dim objWMI
    Dim objNICs
    Dim objNIC
    Dim Property
    Dim sht As Worksheet
    Dim Rng As Range, sRng As Range
    Dim strComputer As String
    strComputer = "."
    Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set objNICs = objWMI.InstancesOf("Win32_NetworkAdapterConfiguration")

    Set sht = ThisWorkbook.Worksheets.Add
    Set Rng = sht.Range("a1")
    Set sRng = Rng
    Rng.Parent.Cells.HorizontalAlignment = xlLeft
    For Each objNIC In objNICs
        For Each Property In objNIC.Properties_
            With Property
                If sRng.Row = 1 Then
                    If IsNull(Property.Value) Then
                        Rng.Resize(2, 1).Value = WorksheetFunction.Transpose(Array(Property.Name, ""))
                    Else
                        If IsArray(Property.Value) Then
                            Rng.Resize(2, 1).Value = WorksheetFunction.Transpose(Array(Property.Name, Property(0)))
                        Else
                            Rng.Resize(2, 1).Value = WorksheetFunction.Transpose(Array(Property.Name, Property.Value))
                        End If
                    End If
                Else
                    If IsNull(Property.Value) Then
                        Rng.Value = ""
                    Else
                        If IsArray(Property.Value) Then
                            Rng.Value = Property(0)
                        Else
                            Rng.Value = Property.Value
                        End If
                    End If
                End If
                Set Rng = Rng.Offset(0, 1)
            End With

        Next
        If sRng.Row = 1 Then
            Set Rng = sRng.Offset(2, 0)
            Set sRng = Rng
        Else
            Set Rng = sRng.Offset(1, 0)
            Set sRng = Rng
        End If
    Next
    With Rng.Parent.Cells
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
End Sub
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

WMI ile Ping atma

İleti#12)  Haldun Alay » 21 Oca 2009 15:08

Kod: Tümünü seç
Sub TestPingWMI()
    MsgBox Ping("XP"), vbInformation  'Bilgisayar Adı Ping
    MsgBox Ping("www.excelvba.net"), vbInformation  'IP adres Ping
    MsgBox Ping("78.111.96.50"), vbInformation  'Web Adresi Ping
    MsgBox Ping("www.buadresyok.com"), vbInformation  'Web Adresi Ping
End Sub

Function Ping(strAddr As String) As String
    Dim blnOK As Boolean
    Dim PingResult As String
    Dim objWMI
    Dim objNetDiag
    Dim strComputerName As String
    strComputerName = "."
    Set objWMI = GetObject("winmgmts:\\" & strComputerName & "\root\cimv2")
    Set objNetDiag = objWMI.Get("NetDiagnostics=@")
    blnOK = objNetDiag.Ping(strAddr, PingResult)
    PingResult = Replace(PingResult, "<br>", vbCrLf, 1, , 1)
    Ping = IIf(blnOK, "Ping işlemi Başarılı", "Ping işlemi başarısız") & vbCrLf & vbCrLf & PingResult
    Set objWMI = Nothing
    Set objNetDiag = Nothing
End Function
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

WMI (Windows Management Instrumentation) ile OS Bilgileri

İleti#13)  Haldun Alay » 21 Oca 2009 15:17

Bu WMI dipsiz kuyu...

Bugünlük bu kadar :)

Şu şahsi bilgileri sorgulamayı başarırsam onu da göndereyim hehe hehe hehe hehe hehe
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

WMI (Windows Management Instrumentation) ile OS Bilgileri

İleti#14)  Tarkan VURAL » 21 Oca 2009 15:23

Elinize sağlık.
Excel ile Ping atmayı denedim. Server'dan demek ki Hotmail sitesini kısıtlamışlar. [komik] Olumsuz yanıtı aldım :D
Erkan beyin kişisel bilgilerine sözüm yok ama ben kendiminkileri FireWall ile koruyorum :lol:
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ?
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 18:27
Konum: @tarkanvural73
Meslek: LUU, Database Expert, Senior Software Specialist, Developer
Yaş: 46
İleti: 27311
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

WMI (Windows Management Instrumentation) ile OS Bilgileri

İleti#15)  Erdinç E Karaçam » 13 Şub 2011 22:31

şkşk [fısıltı] Haldun Abi, muhteşemsin o kadar diyorum abi... [oley] şkşk


Son güncel tutan Haldun Alay, 13 Şub 2011 22:31.
.:Saygılarımla, Erdinç E. Karaçam:.
.:Mum, başka bir mumu yakmakla ışığından birşey kaybetmez:.
HAREZMİ İBN-İ SİNA PİRİ REİS KOCA SİNAN ARF
Kullanıcı avatarı
Erdinç E Karaçam
Site Dostu
 
Adı Soyadı:Erdinç E. Karaçam
Kayıt: 10 Eyl 2008 09:42
Konum: Bursa.Yıldırım.Gemlik. Artvin.Ardanuç.Şavşat
Meslek: İşletme Yönetim Danışmanı
Yaş: 44
İleti: 928
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa


Forum Örnek Kodlar

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

cron
Bumerang - Yazarkafe