Submitted By: Matthew Marr

Scans the local hard drive for .PST files and copies them to the specified location. Note: If a non-existent path is entered, you can type Ctrl+C in the command window to end script execution. Otherwise, the scan operation may take a long time.

Visual Basic
Edit|Remove
Option Explicit

Dim strComputer, strExtension, strDestination, strFolderExists
Dim objWMIService, colFiles, objFile, objFolder, objFolderItem, objShell, objFSO
Const Donotoverwrite = False

On Error Resume Next

Set objFSO = CreateObject("Scripting.FileSystemObject")

strComputer = "."
strExtension = "pst"
strFolderExists = "False"

While strFolderExists <> "True"
    strDestination = InputBox("Enter the destination without the trailing backslash " & vbCr _
    & "i.e. d:\mappeddrive\subfolder", "Destination", "d:\mappeddrive\subfolder")
    If objFSO.FolderExists(strDestination) Then
        Set objFolder = objFSO.GetFolder(strDestination)
        strFolderExists = "True"
    Else
        WScript.Echo "Folder " & strDestination & " does not exist."
        strFolderExists = "False"
    End If
Wend

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colFiles = objWMIService.ExecQuery("Select * from CIM_Datafile")

For Each objFile in colFiles
If LCase(objFile.Extension) = LCase(strExtension) Then
    WScript.Echo " Found " & objFile.Name
    WScript.Echo " Attempting to copy " & objFile.Name & " to " & strDestination & _
        "\" & " ..."
    objFSO.CopyFile objFile.Name , strDestination & "\", Donotoverwrite
    WScript.Echo " Finished " & objFile.Name & "!"
End If
Next

Set strComputer = Nothing
Set strExtension = Nothing
Set strDestination = Nothing
Set strFolderExists = Nothing
Set objWMIService = Nothing
Set colFiles = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
Set objShell = Nothing
Set objFSO = Nothing