什么是获得pst文件大小的最佳途径

Question

有人可能会建议最好的方法来获取pst文件大小并将它们写出到pst路径旁边的相同文本文件。

有人可以请建议最好的方法来抓取pst文件大小，并将它们写出到pst路径旁边的相同文本文件。

Dim objNetworkSet, objFSO, objFolder, objShell, objTextFile, objFile, objWMISysEnv,ObjItem, objTextFileUNC 
Dim strHomePath, strDirectory, strFile, strText, strComputerName,strDirectoryUNC,strFileUNC 
dim colItems 

On Error Resume Next 

Set objNetwork = CreateObject("WScript.Network") 
Set objOutlook = CreateObject("Outlook.Application") 
Set objNS = objOutlook.GetNamespace("MAPI") 
objNS.Logon "Mike", "" , False, True 

Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set wshShell = WScript.CreateObject("WScript.Shell") 

' Setting file names 
strDirectory = "C:\Export" 
strFile = "\" & ObjNetwork.Username & "-" & ObjNetwork.ComputerName & "-PST-Files.txt" 

' Check to see if the file already exists exists 
If objFSO.FolderExists(strDirectory) Then 
    Set objFolder = objFSO.GetFolder(strDirectory) 
Else 
    Set objFolder = objFSO.CreateFolder(strDirectory) 
End If 

If objFSO.FileExists(strDirectory & strFile) Then 
    Set objFolder2 = objFSO.GetFolder(strDirectory) 
Else 
    Set objFile = objFSO.CreateTextFile(strDirectory & strFile) 
    objFile.Close 
End If 


' OpenTextFile Method needs a Const value 
' ForAppending = 8 ForReading = 1, ForWriting = 2 
Const ForAppending = 8 

' Opening text file 
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True) 

For Each objFolder2 In objNS.Folders 

    objTextFile.WriteLine(GetPSTpath(objFolder2.StoreID)) 

    Next 

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) 
    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 

Answer 1

谢谢为您提供帮助和建议。我想出了以下内容：抓取用户默认的Outlook配置文件启动Outlook，验证附加的PST然后发送到文件，包括用户名，PST位置和大小。排除与Enterprise Vault本地缓存相关的.MDC文件。

Dim objNetworkSet, objFSO, objFolder, objShell, objTextFile, objFile, objWMISysEnv,ObjItem, objTextFileUNC 
Dim strHomePath, strDirectory, strFile, strText, strComputerName,strDirectoryUNC,strFileUNC 
dim colItems 

'On Error Resume Next 

Set objNetwork = CreateObject("WScript.Network") 
Set objOutlook = CreateObject("Outlook.Application") 
Set objNS = objOutlook.GetNamespace("MAPI") 
Set WSHShell = WScript.CreateObject("WScript.Shell") 

DefaultOutlookProfile = WSHShell.RegRead("HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\DefaultProfile") 
'MsgBox("DefaultOutlookProfile: " & DefaultOutlookProfile) 
objNS.Logon DefaultOutlookProfile, "", False, True 

Set objFSO = CreateObject("Scripting.FileSystemObject") 

' Setting file names 
strDirectory = "\\NetworkShare\pstlog\" 
strFile = ObjNetwork.Username & "-" & ObjNetwork.ComputerName & "-PST-Files.txt" 

' Check to see if the file already exists exists 
If objFSO.FolderExists(strDirectory) Then 
    Set objFolder = objFSO.GetFolder(strDirectory) 
Else 
    Set objFolder = objFSO.CreateFolder(strDirectory) 
End If 

If objFSO.FileExists(strDirectory & strFile) Then 
    Set objFolder2 = objFSO.GetFolder(strDirectory) 
Else 
    Set objFile = objFSO.CreateTextFile(strDirectory & strFile) 
    objFile.Close 
End If 


' OpenTextFile Method needs a Const value 
' ForAppending = 8 ForReading = 1, ForWriting = 2 
Const ForWriting = 2 

' Opening text file 
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForWriting, True) 

For Each strNS In objNS.Folders 

    'objTextFile.WriteLine(GetPSTpath(strNS.StoreID)) 
    strPath2 = GetPSTpath(strNS.StoreID) 
    'MsgBox("strPath2: " & strPath2) 

    If Not strPath2 = "" And Not Right(strPath2, 4) = ".mdc" Then 
     ' Get the file's size... 
     intSize = FormatNumber((objFSO.GetFile(strPath2).Size/1048576), 2) & " MB" 
     'intSize = intSize/1024 & " MB" 

     ' Write both pieces of information to the output file... 
     objTextFile.WriteLine(ObjNetwork.Username & ", " & strPath2 & ", " & intSize) 
    End If 
Next 

Public 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) 
    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 



If err.number = vbEmpty then 
    Else WScript.echo "VBScript Error: " & err.number 
End If 

Answer 2

如果您GetPSTPath()功能回到你寻找文件的正确路径，而你只想写与文件路径沿着文件大小，你可以这样做：

For Each objFolder2 In objNS.Folders 

    ' Get the file path... 
    strPath = GetPSTpath(objFolder2.StoreID) 

    ' Get the file's size... 
    intSize = objFSO.GetFile(strPath).Size 

    ' Write both pieces of information to the output file... 
    objTextFile.WriteLine strPath & " = " & intSize 

Next