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.
excel vba to check in a computer is on a domain server
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
Developer technologies Visual Basic for Applications
-
Tom van Stiphout 1,861 Reputation points MVP
2021-03-28T02:13:02.233+00:00
2 additional answers
Sort by: Most helpful
-
Tom van Stiphout 1,861 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")
-
James Few 21 Reputation points
2021-03-27T22:21:33.237+00:00 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 SubPrivate 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 WithEnd 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 SubIf 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