Перенос PST файлов
Вложений: 1
Здравствуйте!
Помогите подправить скрипт, для переноса подключенных файлов данных Outlook (.pst).
Ошибка только при работе с именами на русском языке, при отсутствии кириллицы скрипт отрабатывает без ошибок.
Для определения пути, по которому лежит файл, скрипт читает значение реестра (вложение pst.png), и если в пути или имени присутствует русский язык, то выводится следующая ошибка:
C:\Documents\$.0.9.;.K. Outlook\outlook.pst
ERROR
Error number: 52
Скрипт
Код:
'set objects
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = WScript.CreateObject("Wscript.Shell")
Set objNetwork = CreateObject("Wscript.Network")
dim objNS,objOutlook, errorCounter
errorCounter = 0
Call OutlookObjects
strComputer = objNetwork.ComputerName 'returns computer name
'''''''''' setup log files
dim objTextFile, LogFolder
LogFolder = "\\server\logs$\" & strComputer
Call CreateLogFile 'create log file
CheckLoggedOn 'checks to see if a user is logged on - exit if not logged in ****This will pick up the system account or runas account from SCCM - beware.
'setup dictionary
dim pstInfo
set pstInfo = createobject("scripting.Dictionary")
'setup array to store PST locations
Dim pstArray()
Dim counter : counter = 0
'read Outlook Data Stores
For Each objFolder In objNS.Session.Folders 'all data files in outlook
if not isEmpty(GetPSTPath(objFolder.storeid)) then 'filter out empty items
'wscript.echo objFolder
pstPath = GetPSTPath(objFolder.storeid) 'returns the PST file path in text
redim preserve pstArray(counter)
pstArray(counter) = pstPath
counter = counter + 1
pstInfo.add pstPath,objFolder
errorDisplay ("Read Data Store")
End If
Next
displayMsg("------- Open PST files --------") 'log all open PST files
pstKeys = pstInfo.keys 'log all open psts
for each key in pstKeys
displayMsg(key)
Next
displayMsg("------- Remove Network PST --------")
'remove all open PSTs on network shares
for each key in pstKeys
If GetDriveType(left(key,2)) = "Network" Then 'if PST is stored on Network share....
'wscript.echo key
objNS.RemoveStore pstInfo.item(key) 'disconnect the PST - this will not delete it
displayMsg("Removed " & key)
errorDisplay ("Removing Store " & key)
End if
Next
'creating path to outlook data folder - mydocuments\outlook files
'not using special folders as this will re-direct back to the H drive. Must use a hard coded path to the C: drive.
'myDocuments = objShell.SpecialFolders("MyDocuments")
'myDocuments = "c:\documents and settings\" & objNetwork.UserName & "\
copyLocation = "c:\documents and settings\" & objNetwork.UserName & "\My Documents\Outlook Files\"
'wscript.echo copyLocation
GeneratePath(copyLocation) 'create copy location if it does not exist
DisplayMsg("------ Copy to: " & copyLocation & "-------")
'Quit outlook so we can move the PST
Call CloseOutlook
'copy PSTs
for each key in pstKeys
If GetDriveType(left(key,2)) = "Network" Then
'wscript.echo "copy " & key & " to " & copyLocation
fileName = objFSO.GetBaseName(key) + ".pst" 'file name only so we can compare source and destination files
destinationFileName = copyLocation & fileName
DisplayMsg("Copy " & key & " to " & copyLocation)
objFSO.copyfile key,copyLocation 'give time for copy to complete. WARNING.....if user has large PST eg 2GB it could take several minutes to copy.
errorDisplay ("Copying " & key)
wscript.sleep 500
'wscript.echo ValidateCopy(key,destinationFileName)
End If
Next
Call OutlookObjects
'add the PST files back into the store
for each key in pstKeys
If GetDriveType(left(key,2)) = "Network" Then
'wscript.echo ("add " & pstInfo.item(key))
fileName = objFSO.GetBaseName(key) + ".pst"
destinationFileName = copyLocation & fileName
'wscript.echo "add " & destinationFileName
displayMsg("Adding " & destinationFileName)
objNS.AddStore destinationFileName
errorDisplay ("Adding " & destinationFileName)
wscript.sleep 500
End If
Next
objShell.run "outlook.exe"
'Mark the following for deletion in log file
displayMsg("Mark the following PSTs for deletion")
for each key in pstKeys
If GetDriveType(left(key,2)) = "Network" Then
displayMsg("DELETE-" & key)
End If
Next
Call QuitScript
'wscript.echo "complete"
''''''''''''' FUNCTIONS AND SUBS ''''''''''''''''''
Sub OutlookObjects
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
wscript.sleep 3000
End Sub
Sub CloseOutlook
objOutlook.Session.logoff
objOutlook.Quit
Set objOutlook = Nothing
Set objNS = Nothing
WScript.Sleep 3000 'give outlook time to close
KillTask("outlook.exe") 'sometimes outlook does not exit - KILL IT!!!!!
End Sub
Function GetPSTPath(input)
For i = 1 To Len(input) Step 2
strSubString = Mid(input,i,2)
If Not strSubString = "00" Then
strPath = strPath & ChrW("&H" & strSubString)
End If
Next
Select Case True
Case InStr(strPath,":\") > 0
GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
Case InStr(strPath,"\\") > 0
GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
End Select
End Function
Function GetDriveType(input) 'returns the type of drive the PST is stored on.
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_logicaldisk")
For Each objItem In colItems
If objItem.driveType = "4" And objItem.deviceID = input Then 'network drive
GetDriveType = "Network"
ElseIf objItem.driveType = "2" And objItem.deviceID = input Then 'removable drive
GetDriveType = "Removable"
ElseIf objItem.driveType = "3" And objItem.deviceID = input Then 'local disk
GetDriveType = "Local Disk"
End If
Next
End Function
Function KillTask(input)
'kill outlook if it is still running. If outlook is still running, it will prevent the copy of pst.
strComputer = "."
strProcessToKill = input
SET objWMIService = GETOBJECT("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
SET colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '" & strProcessToKill & "'")
count = 0
FOR EACH objProcess in colProcess
objProcess.Terminate()
count = count + 1
NEXT
'wscript.echo "Killed " & count & " instances of " & _
'strProcessToKill & "on " & strComputer
End Function
Sub CreateLogFile
'On Error Resume Next
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'~~~~~~~~~~~~~~ Create Log Folder and Start Log File ~~~~~~~~~~~~~~~~~~~~~~~~~~
'LogFolder = "\\lonlon\logs$\" & strComputer
LogFile = LogFolder & "\" & "pst1.log"
If objFSO.FolderExists(LogFolder) = False Then
Call GeneratePath(LogFolder)
End if
Set objTextFile = objFSO.OpenTextFile(Logfile, ForWriting, True) 'True=create new, false=don't
DisplayMsg(" - Starting Script - ")
DisplayMsg(" ")
DisplayMsg(" - Date: - " & Date)
DisplayMsg(" - Time: - " & Time)
DisplayMsg(" - Logged on User: - " & objNetwork.UserName)
DisplayMsg(" ")
errorDisplay ("Create Log File")
End Sub
Function GeneratePath(pFolderPath)
GeneratePath = False
If Not objFSO.FolderExists(pFolderPath) Then
If GeneratePath(objFSO.GetParentFolderName(pFolderPath)) Then
GeneratePath = True
Call objFSO.CreateFolder(pFolderPath)
End If
Else
GeneratePath = True
End If
End Function
'~~~~~~~~~~~~~~ Write "DisplayMsg" variable to log file ~~~~~~~~~~~~~~
Function DisplayMsg(strMessage)
If iDisplayLogFile = 1 Then
WScript.Echo strMessage
End If
objTextFile.WriteLine strMessage
End Function
Function errorDisplay (desciption)
If Err.Number <> 0 Then
DisplayMsg(" ERROR " & description)
DisplayMsg("Error number: " & err.number)
DisplayMsg("Error description: " & err.description)
err.clear
errorCounter = errorCounter + 1
End If
End Function
Function GetFileSize(input)
Dim File
Set file = objFSO.GetFile(input)
GetFileSize = file.size / 1024
End Function
Function ValidateCopy(source,destination) 'need to convert this to a md5 hash operation http://www.naterice.com/articles/66
sourceFileSize = GetFileSize(source)
destFileSize = GetFileSize(destination)
if sourceFileSize = destFileSize Then
ValidateCopy = "TRUE"
displayMsg("File copy validated")
Else
ValidateCopy = "FALSE"
displayMsg("************ WARNING - File copy operation appears to have failed")
End IF
End Function
Function CheckLoggedOn
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_ComputerSystem")
For Each objItem in colItems
strUserName = objItem.UserName
If IsNull(strUserName) Then
displayMsg("No one logged on - Exiting Script")
wscript.exit 95
Else
displayMsg("User logged on - Continuing Script")
End If
Next
End Function
Sub QuitScript
displayMsg("Exiting script with error code: " & errorCounter)
wscript.quit errorCounter
End Sub
Function CheckProcess (input)
set service = GetObject ("winmgmts:")
'CheckProcess = "FALSE"
for each Process in Service.InstancesOf ("Win32_Process")
If Process.Name = input then
'wscript.echo input & " running"
CheckProcess = "TRUE"
End If
next
End Function
|
