VB Script to move files when emigrating users from XP to Windows 7

Move files

Option Explicit

Dim objFSO
Dim StrDrive
Dim folderobj
Dim FromFolder
Dim ToFolder
Dim FromPath
Dim ToPath
Dim objSubfolder
Dim colSubFolders 
Dim dicSelFolders
Dim FolderToMoveFrom
Dim FolderToMoveTo
Dim Files
Dim OneFile
Dim FileInFromFolder
Dim Fileset
Dim SourceFileName
Dim DestFileName
Dim FileCount
Dim DestFile
Dim DocFolderExist

StrDrive = "F"
FromFolder = ""
ToFolder = "Mina dokument"

Strdrive=UCase(Left(StrDrive,1)) & ":\"

Set objFSO        = CreateObject( "Scripting.FileSystemObject" )
Set FromPath      = objFSO.GetFolder( StrDrive & FromFolder )
Set ToPath        = objFSO.GetFolder( StrDrive & ToFolder ) 
Set colSubFolders = FromPath.Subfolders
Set dicSelFolders = CreateObject( "Scripting.Dictionary" )

'Folders not to move
dicSelFolders.Add "$recycle.bin", ""
dicSelFolders.Add "mina dokument", ""
dicSelFolders.Add "program", ""

'if folder does not exist on destination drive,
' create it and continue

If Not objFSO.FolderExists(StrDrive & "\" & ToFolder) Then
   'WScript.Echo  "Normal run"
   objFSO.CreateFolder StrDrive & ToFolder
   MoveUserFolders()
   MoveUserFiles()
Else
   'WScript.Echo "Rename Mina dokument"
   objFSO.MoveFolder StrDrive & ToFolder, StrDrive & "Gamla " & ToFolder
   objFSO.CreateFolder StrDrive & ToFolder
   MoveUserFolders()
   MoveUserFiles()
End If

Wscript.Quit

Sub MoveUserFolders()

For Each objSubfolder in colSubfolders

If dicSelFolders.Exists( LCase( objSubfolder.Name ) ) Then
   'WScript.Echo "Leaving Folder", objSubfolder.Path
Else
   'WScript.Echo "Moving Folder", objSubfolder.Path
   If FromFolder = "" Then
      FolderToMoveFrom = FromPath & objSubfolder.Name
   Else
      FolderToMoveFrom = FromPath & "\" & objSubfolder.Name
   End If
   FolderToMoveTo = ToPath & "\" & objSubfolder.Name
   objFSO.MoveFolder FolderToMoveFrom, FolderToMoveTo
End If
Next

End Sub

Sub MoveUserFiles()

Set Fileset = FromPath.Files

'if no more subfolders, then go through files
For Each OneFile in Fileset
  SourceFileName = FromPath & "\" & OneFile.name
  DestFileName = ToPath & "\" & OneFile.name

  'if the destination file doesn't exist,
  'then copy the sourcefile to the destination folder
  If Not objFSO.FileExists(DestFileName) Then
    On Error Resume Next
    OneFile.Copy DestFileName
    OneFile.Delete
    On Error GoTo 0
    FileCount = FileCount + 1
  'if the destination file already exists
  Else
    Set DestFile=objFSO.GetFile(DestFileName)
    
    'then check to see if the source file's last modified date
    'is newer than the destination file. If it is,
    'then overwrite the destination file with the source file
    If onefile.DateLastModified > destfile.DateLastModified Then
      'turn all file attributes off to copy updated file over older one
      DestFile.Attributes = 0
      On Error Resume Next
      onefile.Copy DestFileName, True
      On Error GoTo 0
      OneFile.Delete
      FileCount = FileCount + 1
    End If
    Set destfile=Nothing
  End If
Next

End sub