Thread: Retrieve information of computer to do filing

These codes work together to provide the answers you want. I present them in a textbox, but you could write them into cells just as easily. The first code is the macro that collects the data using the other functions:

Option Explicit

Sub CollectComputerInfo()
Dim SN As String, MAC As String, IP As String

   SN = CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber
   MAC = GetMACAddress()
   IP = GetIPAddress()

   MsgBox "Serial Number of the hard drive: " & SN & vbLf & _
       "MAC Address: " & MAC & vbLf & "IP Address: " & IP

End Sub


Function GetMACAddress() As String
'http://www.thecodecage.com/forumz/excel-vba-programming/187032-find-mac-address-my-own-computer-excell-macro.html
Dim strLine As String
Dim bEther As Boolean

bEther = False
Set wsh = CreateObject("WScript.Shell")
Set wshExec = wsh.Exec("ipconfig /all")
Set objStdOut = wshExec.StdOut

Do Until objStdOut.AtEndOfStream
    strLine = objStdOut.ReadLine
    If InStr(strLine, "Ethernet") > 0 Then bEther = True

    If InStr(strLine, "Physical Address") > 0 And bEther Then
        strLine = Right(strLine, 17)
        Exit Do
        End If
Loop

    GetMACAddress = strLine

Set wshExec = Nothing
Set wsh = Nothing
End Function

 
Function GetIPAddress()
'Adapted from http://www.vbaexpress.com/kb/getarticle.php?kb_id=537
Dim wsh As Object
Dim RegEx As Object, RegM As Object
Dim FSO As Object, fil As Object
Dim ts As Object, txtAll As String, TempFil As String
Set wsh = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set RegEx = CreateObject("vbscript.regexp")
    
    TempFil = "C:\myip.txt"
     ' Save ipconfig info to temporary file
    wsh.Run "%comspec% /c ipconfig > " & TempFil, 0, True
    With RegEx
        .Pattern = "(\d{1,3}\.){3}\d{1,3}"
        .Global = False
    End With
    Set fil = FSO.GetFile(TempFil)
     ' Access temporary file
    Set ts = fil.OpenAsTextStream(1)
    txtAll = ts.ReadAll
    Set RegM = RegEx.Execute(txtAll)
     ' Return IP address to Activesheet cell A1 by parsing text

GetIPAddress = RegM(0)
    
ts.Close
' Remove temp file
    Kill TempFil
     
Set ts = Nothing
Set wsh = Nothing
Set fil = Nothing
Set FSO = Nothing
Set RegM = Nothing
Set RegEx = Nothing
End Function

Dear Admin,


Regarding to coding, you forgot to define some variables as object for Function GetMACAddress() , But I manage to get ti right, Thanks

However, how to retrive the time and the date of the current computer? Please advice


Thanks and regards.

What is different?

Perhaps if you add this function in with the others:

Private Declare Function apiGetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _
    (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Private Const MAX_PATH = 260

 
Function fSerialNumber(strDriveLetter As String) As String
'   Function to return the serial number for a hard drive
'   Accepts:
'       strDriveLetter - a valid drive letter for the PC, in the format "C:\"
'   Returns:
'       The serial number for the drive, formatted as "xxxx-xxxx"
    Dim lngReturn As Long, lngDummy1 As Long, lngDummy2 As Long, lngSerial As Long
    Dim strDummy1 As String, strDummy2 As String, strSerial As String
    strDummy1 = Space(MAX_PATH)
    strDummy2 = Space(MAX_PATH)
    lngReturn = apiGetVolumeInformation(strDriveLetter, strDummy1, Len(strDummy1), lngSerial, lngDummy1, lngDummy2, strDummy2, Len(strDummy2))
    strSerial = Trim(Hex(lngSerial))
    strSerial = String(8 - Len(strSerial), "0") & strSerial
    strSerial = Left(strSerial, 4) & "-" & Right(strSerial, 4)
    fSerialNumber = strSerial
End Function

...then change this one line:

SN = fSerialNumber("C:\")

montroseite,

Please take a few minutes to read the form rules, and then start your own thread.

Originally Posted by Kenji

Dear JB, I think i din't mention clearly that the serial that I want to get from computer hard drive. Sorry.
What I am looking for should be [PHYSICAL HARD DISK SERIAL CODE] but not [VOLUME SERIAL NUMBER OF A LOGICAL DRIVE], is it possible to retrive out using VBA excel ?

I guess I don't know. I Googled a bit for the codes offered above, not sure how else to help.

Does this do what you want? (Note: I think the Signature property only works from XP onwards)

Sub GetComputerDetails2()
    Dim lngRow As Long
    Dim objWMIService, colInstances, objInstance
    lngRow = 1
    Set objWMIService = GetObject("winmgmts:")
    Set colInstances = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration")
    For Each objInstance In colInstances
        If Not IsNull(objInstance.IPAddress) Then
            Cells(lngRow, "A").Value = "IP Address" & lngRow & ":"
            Cells(lngRow, "B").Value = objInstance.IPAddress
            Cells(lngRow + 1, "A").Value = "MAC Address" & lngRow & ":"
            Cells(lngRow + 1, "B").Value = objInstance.MACAddress
            lngRow = lngRow + 2
        End If
    Next
    
    Set colInstances = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive")
    For Each objInstance In colInstances
        Debug.Print objInstance.MediaType
        If Not IsNull(objInstance.MediaType) Then
            Cells(lngRow, "A").Value = "HD Serial:"
            Cells(lngRow, "B").Value = objInstance.Signature
            lngRow = lngRow + 1
        End If
    Next


End Sub