Question

有人可以建议获取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

如果您的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

Answer 2

感谢您的帮助和建议。我想出了以下内容，它抓住用户默认的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

获取pst文件大小的最佳方法是什么

2 个答案: