Const ADS_SCOPE_SUBTREE = 2
On Error Resume Next

strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colOSes = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOS in colOSes
  strComputerName = objOS.CSName
Next

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select ADsPath From " & "'LDAP://DC=yourdomain,DC=com' Where objectClass='computer'" & " and Name = '" & strComputerName & "'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
    Set objComputer = GetObject(objRecordSet.Fields("ADsPath").Value)
    objProperty = objComputer.Get("Description")
    If (Err.Number <> 0) Then
	objProperty = "_No AD Description"
    End if
    Const HKEY_LOCAL_MACHINE = &H80000002
    strThisMachine = "."
    Set objRegistry = GetObject ("winmgmts:\\" & strThisMachine & "\root\default:StdRegProv")
    strKeyPath = "System\CurrentControlSet\Services\lanmanserver\parameters"
    strValueName = "srvcomment"
    strDescription = objProperty
    objRegistry.SetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strDescription
    objRecordSet.MoveNext
Loop