'-------------------------------------------------------------------------------
' An die eigenen Bedürfnisse anpassen...
'-------------------------------------------------------------------------------
Private Const COMPUTER = "."
Private Const OLD_DOMAIN = "HOWI"
Private Const NEW_DOMAIN = "MONTAN"
Private Const MOVEUSER_PATH = "moveuser.exe"
'-------------------------------------------------------------------------------

Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_KEY_PROFILELIST = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"

Dim iChoice, oWshShell, oRegistry, vSubkeys, vSubkey, oAccount, oExec, sStdOut

On Error Resume Next

iChoice = MsgBox("Sollen wirklich alle lokalen Benutzerprofile der Domäne """ & OLD_DOMAIN & """ nach """ & NEW_DOMAIN & """ migrieren werden?", vbQuestion + vbYesNo , "Migration der Benutzerprofile")
If (iChoice = vbYes) Then 'Wenn "Ja" gewählt wurde...
  sStdOut = ""
  Set oWshShell = CreateObject("WScript.Shell")
  Set oRegistry = GetObject("winmgmts:\\" & COMPUTER & "\root\default:StdRegProv")
  oRegistry.EnumKey HKEY_LOCAL_MACHINE, REG_KEY_PROFILELIST, vSubkeys
  For Each vSubkey In vSubkeys 'Für alle SIDs...
    If (Len(vSubkey) > 8) Then 'Wenn KEINE System-SID...
      Set oAccount = GetAccountObjectFromSID(vSubkey, COMPUTER)
      If (oAccount.ReferencedDomainName = OLD_DOMAIN) Then 'Wenn alte Domäne...
        If (LCase(oAccount.AccountName) <> "administrator") Then 'Wenn KEIN Administrator...
          Set oExec = oWshShell.Exec(MOVEUSER_PATH & " " & OLD_DOMAIN & "\" & oAccount.AccountName & " " & NEW_DOMAIN & "\" & oAccount.AccountName)
          Do While Not oExec.StdOut.AtEndOfStream
            sStdOut = sStdOut & oExec.StdOut.ReadLine
          Loop
        End If
      End If
    End If
  Next
  
  If (sStdOut <> "") Then 'Wenn migriert...
    MsgBox sStdOut, vbOKOnly, "Migration der Benutzerprofile"
  Else 'Wenn NICHT migriert...
    MsgBox "Es wurden keine lokalen Benutzerprofile migriert.", vbOKOnly, "Migration der Benutzerprofile"
  End If
End If

'...
Function GetAccountObjectFromSID(ByVal sSID, ByVal sComputer)
  Dim oWMIService
  
  If (sComputer = "") Then sComputer = "."
  
  Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
  Set GetAccountObjectFromSID = oWMIService.Get("Win32_SID.SID='" & sSID & "'")
End Function