10
VB GebObject - Cannot create ActiveX component
Hallo zusammen,
ich muss für Windows 10 ein Programm erstellen, das 2 Benutzer erstellt, bei denen das Passwort nie abläuft und nicht gewechselt werden kann. Ausserdem sollen die beiden User in der "Administrators" Gruppe sein. Dazu habe ich ein Visual Basic Programm erstellt, welches bei der Ausführung leider einen Fehler anzeigt.
Ich hoffe auf schnelle Hilfe
Gruss Patrick
ich muss für Windows 10 ein Programm erstellen, das 2 Benutzer erstellt, bei denen das Passwort nie abläuft und nicht gewechselt werden kann. Ausserdem sollen die beiden User in der "Administrators" Gruppe sein. Dazu habe ich ein Visual Basic Programm erstellt, welches bei der Ausführung leider einen Fehler anzeigt.
Module Module1
Sub SetUserFlag(ByRef objUser As Object, Flag As Integer)
Dim Flags
Flags = objUser.Get("UserFlags")
objUser.put("Userflags", Flags Or Flag)
objUser.setinfo()
End Sub
Sub Main()
Const ADS_UF_DONT_EXPIRE_PASSW As Integer = &H10000
Const ADS_UF_PASSWD_CANT_CHANGE As Integer = &H40
Const UserLabT As String = "LabTech"
Const UserLabA As String = "Labadmin"
Const Group As String = "Administrators"
Dim Passwort As String = "blabla" & Year(Now())
Dim obUser1 As Object = GetObject("WinNT://" & My.Computer.Name & "/" & UserLabT)
Dim obUser2 As Object = GetObject("WinNT://" & My.Computer.Name & "/" & UserLabA)
Dim oDomain As Object = GetObject("WinNT://" & My.Computer.Name)
Dim oUser1 As Object = oDomain.Create("user", UserLabT)
Dim oUser2 As Object = oDomain.Create("user", UserLabA)
Dim oGroup As Object = oDomain.GetObject("Group", Group)
oUser1.setInfo()
oUser1.SetPassword(Passwort)
oUser1.SetInfo()
SetUserFlag(obUser1, +ADS_UF_DONT_EXPIRE_PASSW)
SetUserFlag(obUser1, +ADS_UF_PASSWD_CANT_CHANGE)
oUser2.setInfo()
oUser2.setpassword("blabla")
oUser2.setInfo()
SetUserFlag(obUser2, +ADS_UF_DONT_EXPIRE_PASSW)
SetUserFlag(obUser2, +ADS_UF_PASSWD_CANT_CHANGE)
oGroup.Add("WinNT://" & My.Computer.Name & "/" & UserLabT)
oGroup.Add("WinNT://" & My.Computer.Name & "/" & UserLabA)
End Sub
End ModuleIch hoffe auf schnelle Hilfe
Gruss Patrick
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 305169
Url: https://administrator.de/contentid/305169
Ausgedruckt am: 15.11.2024 um 19:11 Uhr
10 Kommentare
Neuester Kommentar
Moin,
warum den in VB?
Ich würde dsas entweder mittels
oder per PowerShell machen.
lg,
Slainte
warum den in VB?
Ich würde dsas entweder mittels
NET USER username "password" /ADD
NET LOCALGROUP "group" "user" /add oder per PowerShell machen.
lg,
Slainte
Hi,
wenn Du in Zeile 24/25 die User erst erstellt, dann kannst Du sie doch nicht schon in Zeile 19/20 beziehen wollen? Kommentier mal 19/20 aus.
E.
wenn Du in Zeile 24/25 die User erst erstellt, dann kannst Du sie doch nicht schon in Zeile 19/20 beziehen wollen? Kommentier mal 19/20 aus.
E.
Hab den Code jetzt verändert
doch leider bekomme ich den Fehler immernoch 
Module Module1
Sub SetUserFlag(ByRef objUser As Object, Flag As Integer)
Dim Flags
Flags = objUser.Get("UserFlags")
objUser.put("Userflags", Flags Or Flag)
objUser.setinfo()
End Sub
Sub Main()
Const ADS_UF_DONT_EXPIRE_PASSW As Integer = &H10000
Const ADS_UF_PASSWD_CANT_CHANGE As Integer = &H40
Const UserLabT As String = "LabTech"
Const UserLabA As String = "Labadmin"
Const Group As String = "Administrators"
Dim Passwort As String = "blabla" & Year(Now())
Dim oDomain As Object = GetObject("WinNT://" & My.Computer.Name)
Dim oUser1 As Object = oDomain.Create("user", UserLabT)
Dim oUser2 As Object = oDomain.Create("user", UserLabA)
Dim obUser1 As Object = GetObject("WinNT://" & My.Computer.Name & "/" & UserLabT)
Dim obUser2 As Object = GetObject("WinNT://" & My.Computer.Name & "/" & UserLabA)
Dim oGroup As Object = oDomain.GetObject("Group", Group)
oUser1.setInfo()
oUser1.SetPassword(Passwort)
oUser1.SetInfo()
SetUserFlag(obUser1, +ADS_UF_DONT_EXPIRE_PASSW)
SetUserFlag(obUser1, +ADS_UF_PASSWD_CANT_CHANGE)
oUser2.setInfo()
oUser2.setpassword("blabla")
oUser2.setInfo()
SetUserFlag(obUser2, +ADS_UF_DONT_EXPIRE_PASSW)
SetUserFlag(obUser2, +ADS_UF_PASSWD_CANT_CHANGE)
oGroup.Add("WinNT://" & My.Computer.Name & "/" & UserLabT)
oGroup.Add("WinNT://" & My.Computer.Name & "/" & UserLabA)
End Sub
End Moduledoch leider bekomme ich den Fehler immernoch
Na logisch!Die User sind erst mit Ausführung der Zeilen 33 bzw. 40 erstellt. Also kannst Du auch erst danach mittels GetObject eine Referenz darauf beziehen.
Mal am Rande: Wozu brauchst Du die Referenzen obUser1 und obUser2 (Zeilen 24/25) überhaupt? Diese werden doch gar nicht weiter verwendet?
Und noch ein Hinweis: Zeile 15 --> Hast Du ein englisches Windows? Falls nein, dann muss das hier "Administratoren" lauten.
Und als Ergänzung: Prüfen ob der User überhaupt schon existiert sollte man natürlich auch, z.B. mit einem TryCatch um das GetObject und dann das Objekt auf "Nothing" prüfen, bevor man überhaupt einen User mit dem Namen erstellt ...
Gruß skybird
Gruß skybird
Zitat von @129413:
Und als Ergänzung: Prüfen ob der User überhaupt schon existiert sollte man natürlich auch, z.B. mit einem TryCatch um das GetObject und dann das Objekt auf "Nothing" prüfen, bevor man überhaupt einen User mit dem Namen erstellt ...
VBA kann kein Try..Catch. Nicht meines Wissens.Und als Ergänzung: Prüfen ob der User überhaupt schon existiert sollte man natürlich auch, z.B. mit einem TryCatch um das GetObject und dann das Objekt auf "Nothing" prüfen, bevor man überhaupt einen User mit dem Namen erstellt ...
Wenn, dann über "on error resume next".
Hmm ja, sieht für mich aber nach VB.Net Konsolen-Code aus ...
Vor allem die Fehlermeldung in der Konsole:
Microsoft.VisualBasic.Interaction ....
Und dem Module ...
Und sowas, mit Variable deklarieren und Wert direkt zuweisen
Dim Passwort As String = "blabla"
geht in VBA ja auch nicht.
Das hat der TO sicher in die falsche Kategorie gepostet.
Vor allem die Fehlermeldung in der Konsole:
Microsoft.VisualBasic.Interaction ....
Und dem Module ...
Und sowas, mit Variable deklarieren und Wert direkt zuweisen
Dim Passwort As String = "blabla"
geht in VBA ja auch nicht.
Das hat der TO sicher in die falsche Kategorie gepostet.
VBA kann kein Try..Catch.
Der Code (und die Fehlermeldung) sieht eher nach VB.NET als nach VBA aus @Patrick-IT
Geh doch mal mit Step-Trough durch den Code und sag uns, bei welchem GetObject genau der Fehler Auftritt - dann wird's evtl. einfacher .)
Ja, habt recht. Habe mich vom gewählten Themenbereich täuschen lassen ...
mal schnell hingezimmert:
Module Module1
Sub SetUserFlag(ByRef objUser As Object, Flag As Integer)
Dim Flags As Object
Flags = objUser.Get("UserFlags")
objUser.put("Userflags", Flags Or Flag)
End Sub
Sub Main()
Dim oGroup As Object = Nothing, strAdminGroup As String = ""
Const ADS_UF_DONT_EXPIRE_PASSW As Integer = &H10000
Const ADS_UF_PASSWD_CANT_CHANGE As Integer = &H40
Dim obj As Object = GetObject("winmgmts://./root/cimv2").ExecQuery("Select * From Win32_Group where SID='S-1-5-32-544'")
For Each o as Object In obj
If strAdminGroup = "" Then strAdminGroup = o.Name
Next
Dim users As String() = {"LabTech", "LabAdmin"}
Dim Passwort As String = "blabla" & Year(Now())
Dim oDomain As Object = GetObject("WinNT://" & My.Computer.Name)
Try
oGroup = oDomain.GetObject("Group", strAdminGroup)
Catch ex As Exception
End Try
For Each user As String In users
Dim oUser As Object = Nothing
Try
oUser = GetObject("WinNT://" & My.Computer.Name & "/" & user & ",user")
Catch ex As Exception
End Try
If oUser Is Nothing Then
oUser = oDomain.Create("user", user)
If Not oUser Is Nothing Then
oUser.Setinfo()
oUser.SetPassword(Passwort)
SetUserFlag(oUser, +ADS_UF_DONT_EXPIRE_PASSW)
SetUserFlag(oUser, +ADS_UF_PASSWD_CANT_CHANGE)
oUser.SetInfo()
If Not oGroup Is Nothing Then oGroup.Add("WinNT://" & My.Computer.Name & "/" & user)
End If
End If
Next
End Sub
End Module
