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

Private Const TemporaryFolder = 2
Private Const ForReading = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_KEY_PROFILELIST = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
Private Const LOG_FILENAME = "moveuser.log"

Dim iChoice, oFSO, oWshShell, oRegistry, sLogFilePath, vSubkeys, vSubkey, oAccount, sStdOut, oTextFile

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 oFSO = CreateObject("Scripting.FileSystemObject")
  sLogFilePath = oFSO.GetSpecialFolder(TemporaryFolder) & "\" & LOG_FILENAME
  oFSO.DeleteFile sLogFilePath, True
  
  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...
          oWshShell.Run "%comspec% /c " & MOVEUSER_PATH & " " & OLD_DOMAIN & "\" & oAccount.AccountName & " " & NEW_DOMAIN & "\" & oAccount.AccountName & " >> """ & sLogFilePath & """", , True
        End If
      End If
    End If
  Next
  
  If (oFSO.FileExists(sLogFilePath) = True) Then 'Wenn die Log-Datei vorhanden ist...
    Set oTextFile = oFSO.OpenTextFile(sLogFilePath, ForReading)
    sStdOut = oTextFile.ReadAll
    oTextFile.Close
    oFSO.DeleteFile sLogFilePath, True
  End If
  
  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