Archive_Mailboxes.vbs


'--------------------------------------------------------------------------------------
'  ARCHIVE_MAILBOX.VBS
'
'  Usage:  cscript archive_mailbox.vbs
'
'  Script actions:
'     + Finds Disabled mail users
'     + Checks the extensionAttribute used for the Archive flag
'     + Archives the mailbox if the flag was not set
'
'  All script messages (Errors, Warning, Information) are written to the
'  Application Events Log with a type of WSH.
'
'  Written By Carol Wapshere
'
'--------------------------------------------------------------------------------------

Option Explicit

'------------------------------------------------------------------------
'
'  GLOBAL DECLARATIONS
'
'------------------------------------------------------------------------

Const DISABLE_RECEIVE = TRUE
Const ARCHIVE_FLAG_ATTRIB = "extensionAttribute15"
Const ARCHIVE_FLAG_TEXT = "Mailbox Archived"
Const EXCH_MB_SERVER = "MAILSERVER"
Const AD_ROOT_DN = "DC=myorg,DC=com"
Const EXCH_POWERSHELL_SNAPIN = "C:\Program Files\Microsoft\Exchange Server\Bin\ExShell.psc1"
Const POWERSHELL_SCRIPT = "C:\scripts\archive_mailbox\archive_mailbox.ps1"
Const LOG_FILE = "C:\scripts\archive_mailbox\archive_mailbox_log.txt"
Const POWERSHELL_TIMEOUT = 4000 'seconds

'If the following are changed they must also be changed in ps1 script file
Const ARCHIVE_FOLDER = "C:\Archived_Mailboxes"
Const CSV_FILE = "c:\scripts\archive_mailbox\archive_mailbox_todo.csv"
Const PS1_OUTPUT_FILE = "c:\scripts\archive_mailbox\ps1output.txt"

Const EVENT_SUCCESS = 0
Const EVENT_ERROR = 1
Const EVENT_WARNING = 2
Const EVENT_INFORMATION = 4
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const ASCII = 0
Const ADS_UF_ACCOUNTDISABLE = &H02
Const ADS_PROPERTY_CLEAR = 1

Dim strDN, strPST, strLine, powershellCommand
Dim objFSO, objFile_CSV, objShell
Dim objUser, objConnection, objCommand, objRecordSet
Dim bPowershellFinished, objFile_Ps1Output
Dim arrToArchive()
Dim i, count

'------------------------------------------------------------------------
'
'  MAIN BODY
'
'------------------------------------------------------------------------

'--------------------------------------------------
' Find Disabled mailusers with no Archive flag
'--------------------------------------------------

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000

objCommand.CommandText = _
"<LDAP://" & AD_ROOT_DN & ">;(&(objectCategory=User)" & _
"(userAccountControl:1.2.840.113556.1.4.803:=2)(homeMDB=*));" &_
"distinguishedName,extensionAttribute15;Subtree"
Set objRecordSet = objCommand.Execute

i = 0
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
  If IsNull(objRecordSet.Fields("extensionAttribute15").Value) Then
    ReDim Preserve arrToArchive(i)
    arrToArchive(i) = objRecordSet.Fields("distinguishedName").Value
    i = i + 1
  End If
  objRecordSet.MoveNext
Loop

If i=0 Then
  LogEvent EVENT_INFORMATION, "EXIT", "No mailboxes to archive."
End If

'-------------------------------------------------------------------
' Create the CSV file
'-------------------------------------------------------------------
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile_CSV = objFSO.OpenTextFile(CSV_FILE, ForWriting, TRUE, ASCII)
objFile_CSV.Writeline("DN")

For each strDN in arrToArchive
  objFile_CSV.Writeline(chr(34) & strDN & chr(34))
Next
objFile_CSV.Close

'-------------------------------------------------------------------
' Call the Powershell script to export mailboxes
' See https://www.wapshere.com/missmiis/archiving-exchange-2007-mailboxes
'-------------------------------------------------------------------

If objFSO.FileExists(PS1_OUTPUT_FILE) Then
  objFSO.DeleteFile(PS1_OUTPUT_FILE)
End If

powershellCommand = "PowerShell.exe -PSConsoleFile " & chr(34) & EXCH_POWERSHELL_SNAPIN & chr(34) & " -Command " & chr(34) & ". '" & POWERSHELL_SCRIPT & "'" & chr(34) & "-NoExit"

Set objShell = CreateObject("Wscript.Shell")
objShell.Run(powershellCommand)

' Loop until powershell has finished writing to the output file
' If we wait more than the timeout then fail with an error.
bPowershellFinished = False
count = 0
On Error Resume Next
Do
  count = count + 1
  set objFile_Ps1Output = objFSO.OpenTextFile(PS1_OUTPUT_FILE, ForReading, ASCII)
  If Err.Number <> 0 Then
    WScript.Sleep 1000
  Else
    bPowershellFinished = True
  End If
  Err.Clear
Loop Until bPowershellFinished Or (count = POWERSHELL_TIMEOUT)
On Error GoTo 0

If count = POWERSHELL_TIMEOUT Then
  LogEvent EVENT_ERROR, "EXIT", "Fatal: Powershell script did not complete in a reasonable lenth of time."
Else
  wscript.echo objFile_Ps1Output.ReadAll
  objFile_Ps1Output.Close
End If

'------------------------------------------
' Verify Archive
' Update attribute flag and logging
'------------------------------------------
Set objFile_CSV = objFSO.OpenTextFile(PS1_OUTPUT_FILE, ForReading, ASCII)

Do Until objFile_CSV.AtEndOfStream
  strLine = objFile_CSV.ReadLine
  Do Until InStr(strLine, "DistinguishedName") Or objFile_CSV.AtEndOfStream
    strLine = objFile_CSV.ReadLine
  Loop

  If InStr(strLine, "DistinguishedName") Then
    strDN = Trim(Split(strLine,": ")(1))
    If InStr(LCase(strDN), LCase(AD_ROOT_DN)) = 0 Then
      ' Deal with DN split across two lines
      strLine = objFile_CSV.ReadLine
      strDN = strDN & Trim(strLine)
    End If
    wscript.echo "Verifying " & strDN

    Do Until InStr(strLine, "PSTFilePath")
      strLine = objFile_CSV.ReadLine
    Loop

    strPST = Trim(Split(strLine,": ")(1))

    Do Until InStr(strLine, "StatusCode")
      strLine = objFile_CSV.ReadLine
    Loop

    If( Trim(Split(strLine,": ")(1)) = "0" ) Then
      LogToFile "Archived " & strPST
      LogEvent EVENT_SUCCESS, "RETURN", "The mailbox of disabled user " & strDN &_
          " has been archived to " & strPST
      Set objUser = GetObject("LDAP://" & strDN)
      objUser.Put "extensionAttribute15", ARCHIVE_FLAG_TEXT & " to " & strPST & " on " & Now()
      objUser.SetInfo

    Else 'Archive Failed
      LogEvent EVENT_ERROR, "RETURN", "Mailbox archiving failed for disabled user " & strDN

    End If
  End If 'InStr(strLine, "DistinguishedName")
Loop

objFile_CSV.Close

'------------------------------------------------------------------------
'
'  SUBROUTINES
'
'------------------------------------------------------------------------

'---------------------------------------------------------------
'  SUB LOGEVENT
'
'  Writes Messages into the Application Event Log
'---------------------------------------------------------------
Sub LogEvent(eventType, action, message)
  Dim objShell

  wscript.echo message
  message = "ARCHIVE_MAILBOX Script" & VBNewLine & message
  Set objShell = Wscript.CreateObject("WScript.Shell")
  objShell.LogEvent eventType, message

  If action = "EXIT" then
    Wscript.Quit
  End If
End Sub

'---------------------------------------------------------------
'  SUB LOGTOFILE
'
'  Writes Status into the Log File
'---------------------------------------------------------------
Sub LogToFile(message)
  Dim objLogFSO, objLogFile

  Set objLogFSO = CreateObject("Scripting.FileSystemObject")
  Set objLogFile = objLogFSO.OpenTextFile(LOG_FILE, ForAppending, TRUE)

  objLogFile.Writeline(Now() & ": " & message)
  objLogFile.Close
End Sub