excel vba to check in a computer is on a domain server

James Few 21 Reputation points
2021-03-26T01:32:45.657+00:00

I have an project that I have started with the idea creating an excel macro in VBA to help with collecting data that takes a while to do manually. What I am wanting to do is take a given computer name, i.e. Lexington, and have the VBA to check the active directory to see if the named computer is actually listed or if not. I have around six thousand computers that I may need to verify anywhere from twenty to three hundred on a daily basis. I have been doing this manually for a while and it takes a while to process and I have an increase in other task given to me. Currently the naming process used is type or scan the computer serial number which is then automatically used to create the computer name based on type of computer. This correctly. What I am in need of help is getting the VBA to automatically scan the AD for the computer name and record if it listed or not. I will provide my code thus far. Private Sub cmdQuit_Click() ' removes from memory Unload Me End Sub Private Sub cmdRecord_Click() ' Defines Varibles to be used Dim iRow As Long Dim LValue As String Dim ws As Worksheet ' Dim NameCheck As String Set ws = Worksheets("Renamed device") ' Searches for the next blank row for data entry iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1 ' Checks for a blank textbox and request data to be enter. Sets focus back on the textbox. If Trim(Me.txtAsset.Value) = "" Then Me.txtAsset.SetFocus MsgBox "Pease enter an serial number." End If ' Rename the asset number to desired name based upon checkbox value. ' Modified to reflect change in naming convention. (2019) With ws If chkbxOutdoor.Value = False Then Me.txtAsset.Value = WorksheetFunction.Substitute(txtAsset.Value, "ASUS", "ASUS-DK") .Cells(iRow, 1).Value = Me.txtAsset.Text ' NameCheck = Me.txtAsset.Text Me.txtAsset.Value = "" Me.txtAsset.SetFocus Else lastfive = Right(Me.txtAsset.Value, 5) LValue = "ASUS-LT" & lastfive .Cells(iRow, 1).Value = LValue chkbxOutdoor.Value = False ' NameCheck = LValue Me.txtAsset.Value = "" Me.txtAsset.SetFocus End If If chkdomain.Value = False Then .Cells(iRow, 2).Value = "Not on Domain" Me.txtAsset.SetFocus Else .Cells(iRow, 2).Value = "On Domain" Me.txtAsset.SetFocus End If If optDOA.Value = True Then .Cells(iRow, 3).Value = "Unit is Dead On Arrival" Me.txtAsset.SetFocus Elseif optBOUNCER.Value = True then .Cells(iRow, 3).Value = "Unit returned unrepaired" Me.txtAsset.SetFocus End If ' resets option buttons to false optDOA.Value = False optBOUNCER.Value = False End With End Sub Private Sub cmdClear_Click() ' Clears the textbox of entered data and sets the focus back on the textbox txtAsset.Value = "" NameCheck = "" Me.txtAsset.SetFocus End Sub

0 comments No comments
{count} votes

Accepted answer
  1. Tom van Stiphout 1,621 Reputation points MVP
    2021-03-28T02:13:02.233+00:00

    These 3 lines is all it takes to create a function (I call mine GetADComputer() to get the name of the Active Directory host.
    Of course in non-domain networks this will fail and then you know.
    I leave it up to you to incorporate this code into yours.

    0 comments No comments

2 additional answers

Sort by: Most helpful
  1. Tom van Stiphout 1,621 Reputation points MVP
    2021-03-26T16:07:56.437+00:00

    Ican'treadcodethatisalltogether

    Dim objRoot         As ActiveDs.IADs        'Requires reference to "Active DS Type Library" (activeds.tlb)
    
    Set objRoot = GetObject("LDAP://RootDSE")
    GetADComputer = objRoot.Get("dsServiceName")
    
    0 comments No comments

  2. James Few 21 Reputation points
    2021-03-27T22:21:33.237+00:00

    @Tom van Stiphout ,

    I tend to forget not everyone reads as easy as I do. Hope this way clears up any confusion. I am looking over the code you provided and can't help wondering if it really that easy. I was expecting more
    code than four lines. I will plug this into my code. Thank you for your help and quick response.
    Also to ensure that I fully understand how your code needs to be modified for my needs, please show where the changes need to be made. I will use corp.ds.thisisreallycool.com as an Active directory server in this case.

    Private Sub cmdQuit_Click()
    ' removes from memory
    Unload Me
    End Sub

    Private Sub cmdRecord_Click()
    ' Defines Varibles to be used
    Dim iRow As Long
    Dim LValue As String
    Dim ws As Worksheet
    Set ws = Worksheets("Renamed device")
    ' Searches for the next blank row for data entry
    iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
    ' Checks for a blank textbox and request data to be enter. Sets focus back on the textbox.
    If Trim(Me.txtAsset.Value) = "" Then
    Me.txtAsset.SetFocus MsgBox "Pease enter an serial number."
    End If

    ' Rename the asset number to desired name based upon checkbox value.
    ' Modified to reflect change in naming convention. (2019)

    With ws

    If chkbxOutdoor.Value = False Then
    Me.txtAsset.Value = WorksheetFunction.Substitute(txtAsset.Value, "ASUS", "ASUS-DK")
    .Cells(iRow, 1).Value = Me.txtAsset.Text
    Me.txtAsset.Value = "" Me.txtAsset.SetFocus
    Else
    lastfive = Right(Me.txtAsset.Value, 5)
    LValue = "ASUS-LT" & lastfive .Cells(iRow, 1).Value = LValue
    chkbxOutdoor.Value = False
    Me.txtAsset.SetFocus
    End If

    ' resets option buttons to false
    optDOA.Value = False
    optBOUNCER.Value = False
    End With

    End Sub

    Private Sub cmdClear_Click()
    ' Clears the textbox of entered data and sets the focus back on the textbox
    txtAsset.Value = ""
    Me.txtAsset.SetFocus
    End Sub

    If optDOA.Value = True Then
    .Cells(iRow, 3).Value = "Unit is Dead On Arrival"
    Me.txtAsset.SetFocus
    Elseif optBOUNCER.Value = True then
    .Cells(iRow, 3).Value = "Unit returned unrepaired"
    Me.txtAsset.SetFocus
    End If

    ' ** planning to add **

    If chkdomain.Value = False
    Then
    .Cells(iRow, 2).Value = "Not on Domain"
    Me.txtAsset.SetFocus
    Else
    .Cells(iRow, 2).Value = "On Domain"
    Me.txtAsset.SetFocus
    End If

    0 comments No comments