Retrieve System information by VBA

powerz · May 17th, 2006, 03:03 PM

Hi. I want to gather system information by VBA(such IP address,Hostname, MAC address, Domain name, OS version). The only way I know is to use ipconfig to generate a text file. Then read the text file via scripting.FileSystemObject.
Is there a better solution ?

Thank you in advance.

mmcdonal · May 18th, 2006, 06:40 AM

Yes. How do you want to use it? Are you using it from within Access?

You want to start with WMI scripting to get this info. It can run from within Access generally, depending on security settings.

For example, here is OS information:

Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
For Each objItem In colItems
    objItem.Caption 'OS
    objItem.BuildNumber 'OS Build
    objItem.CSDVersion '
    objItem.Version '
Next

Here is some system information:

Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
For Each objItem In colItems
    objItem.Domain
    objItem.Manufacturer
    objItem.Model
Next

Here is network adapter info (there are a lot of these on each adapter so be prepared to add a conditional to remove things like WAN MiniPort etc to get the one you want):

Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter",,48)
For Each objItem in colItems
    objItem.AdapterType
    objItem.Description
       objItem.MACAddress
Next

Here is how to get the IP Address:

Set objShell = WScript.CreateObject("WScript.Shell")
Set objExecObject = objShell.Exec("%comspec% /c ipconfig.exe")
Do Until objExecObject.StdOut.AtEndOfStream
    strLine = objExecObject.StdOut.ReadLine()
    strIP = InStr(strLine, "Address")
    If strIP <> 0 Then
        IPArray = Split(strLine, ":")
        strIPAddress = IPArray(1)
    End If
Loop

You can capture each of these values by assigning them to variables as you run each routine, then open a connection to your database and push the variables into the proper table with something like:

   objRS.AddNew
   objRS("IP") = strIPAddress
   ...
   objRS.Update

Does this help?

mmcdonal

mmcdonal · May 18th, 2006, 06:43 AM

Go to Microsoft.com and do a search for the "Scripting Guys" and download scriptomatic to get you started on the full code.

Also, please get Windows 2000 Scripting and Advanced VBScript by MSPress if you are going to get serious with this. These are THE best books on the subject (sorry Wrox, I have all your VB, VBA books and they are great references, too.)

HTH

mmcdonal

powerz · May 19th, 2006, 11:23 AM

Thanks Mmcdonal.
Here is my code. The only problem is sometimes it returns "Permission denied" and I have to re-click the button then it works.

stTempFile = "c:\temp_abcde.txt"
a = Shell("cmd /c ipconfig /all > " & stTempFile, vbHide)
Pause 1
b = Shell("cmd /c set >> " & stTempFile, vbHide)
Pause 1
Set fso = CreateObject("scripting.FileSystemObject")
If fso.FileExists(stTempFile) Then
    Set objStream = fso.openTextFile(stTempFile, 1, False, 0)
End If
stInfo = ""
Do While Not objStream.atEndOfStream
stLine = objStream.ReadLine
If InStr(1, stLine, "Host Name") > 0 Or _
    InStr(1, stLine, "Physical Address") > 0 Or _
    InStr(1, stLine, "IP Address") > 0 Then
stInfo = stInfo + Right(stLine, Len(stLine) - 36)
End If
If InStr(stLine, "UserDOMAIN") > 0 Then
stInfo = stInfo + Right(stLine, Len(stLine) - 11) + " "
End If
If InStr(stLine, "UserName") > 0 Then
stInfo = stInfo + Right(stLine, Len(stLine) - 9)
End If

Loop
If Len(stInfo) > 0 Then
Me.Text174.Value = Left(stInfo, 50)
Me.re_message = stInfo
End If
objStream.Close
Set objFile2Delete = fso.GetFile(stTempFile)
objFile2Delete.Delete

I think the error may come from creating the temporary file. I should use your "objExecObject = objShell.Exec("%comspec% /c ipconfig.exe")
" to avoid the temporary file. Any comment?

??VBA and ACCESS ??

powerz · May 19th, 2006, 12:25 PM

Hi Mmcdonal, I just tried your code:
Set objShell = WScript.CreateObject("WScript.Shell")
The system returns "Object required" error. Please help.

I have selected "Microsoft Script Control 1.0", "ms Scripting Runtime","ms WMI Scripting V1.1 Library" in addition to my current references. but it still does not work.
Thanks.

??VBA and ACCESS ??

mmcdonal · May 19th, 2006, 12:33 PM

Dim objShell As Variant

That should do it.

mmcdonal

powerz · May 19th, 2006, 03:22 PM

Hi Mmcdonal. Same error "Runtime error 424. Object Required"
Could you try it ?

Dim objShell As Variant
[error here]==>Set objShell = WScript.CreateObject("WScript.Shell")

I am using Access 2000 and Windows 2000 pro.

Anyone else want to try the code ?

powerz · May 23rd, 2006, 04:19 PM

In case someone is still wondering the solution.
I correct error by deleting the word "WScript" like below.

Dim objShell As Variant
Set objShell = CreateObject("WScript.Shell")

Everything is fine now. Thank mmcdonal again.

??VBA and ACCESS ??

jose.natali · August 13th, 2013, 03:49 PM

This is what I use:

Code:

Public Function sCurrentUserName() As String

  sCurrentUserName = CreateObject("wscript.network").UserName

End Function

Function sComputerName() As String

  sComputerName = CreateObject("wscript.network").Computername
  
End Function

Public Function getMyIP()

    Dim myWMI As Object, myObj As Object, Itm
    
    Set myWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set myObj = myWMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    For Each Itm In myObj
      getMyIP = Itm.IPAddress(0)
      Exit Function
    Next
End Function

Public Function MAC_Address() As String

    Dim myWMI As Object, myObj As Object, Itm
    
    Set myWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set myObj = myWMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    For Each Itm In myObj
      MAC_Address = Itm.MACAddress
      Exit Function
    Next
End Function

Public Function OSInfo() As Variant

  Dim arrOSInfo(1 To 3)   As String
  Dim myWMI As Object, myObj As Object, Itm
    
  Set myWMI = GetObject("winmgmts:\\.\root\cimv2")
    
  Set myObj = myWMI.ExecQuery("Select * from Win32_OperatingSystem", , 48)

  For Each Itm In myObj
    arrOSInfo(1) = Itm.Caption 'OS
    arrOSInfo(2) = Itm.BuildNumber 'OS Build
    arrOSInfo(2) = Itm.CSDVersion '
    arrOSInfo(3) = Itm.Version '
  Next

  OSInfo = arrOSInfo()
End Function

Public Function CompuInfo() As Variant

  Dim arrCompuInfo(1 To 3)   As String
  Dim myWMI As Object, myObj As Object, Itm
    
  Set myWMI = GetObject("winmgmts:\\.\root\cimv2")
    
  Set myObj = myWMI.ExecQuery("Select * from Win32_ComputerSystem", , 48)

  For Each Itm In myObj
    arrCompuInfo(1) = Itm.Domain
    arrCompuInfo(2) = Itm.Manufacturer
    arrCompuInfo(3) = Itm.Model
  Next

  CompuInfo = arrCompuInfo()

End Function

Public Function VBA_Version() As String

  VBA_Version = Application.VBE.Version ' less information, but faster

End Function