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

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

vbscript outlook

Vbscript 获取pst文件大小的最佳方法是什么,vbscript,outlook,Vbscript,Outlook,有人可以建议最好的方法获取pst文件大小，并将其写入pst路径旁边的同一文本文件中 Dim objNetworkSet, objFSO, objFolder, objShell, objTextFile, objFile, objWMISysEnv,ObjItem, objTextFileUNC Dim strHomePath, strDirectory, strFile, strText, strComputerName,strDirectoryUNC,strFileUNC dim colIt

有人可以建议最好的方法获取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

有人可以建议最好的方法获取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

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

谢谢你的帮助和建议。我提出了以下内容，它获取用户默认的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。你是对的，我应该问：帮助调整Outlook配置文件中找到的对象的大小。输出文件按如下方式列出对象。C:\Users\mike\AppData\Local\KVS\Enterprise Vault\C1576C0719evs01.mdc:\My Outlook Data File1.pst我不太理解您的全部评论。请重新编写和/或使用相关信息修改您的问题，好吗？scrript正在登录Outlook配置文件Mike Set objNS=objOutlook.GetNamespaceMAPI objNS.Logon Mike，，False，是的，我可以将此配置文件中找到的对象写入文本文件.pst.mdc等，但也需要将这些对象的大小写入文本文件-well.Dir/a/s c:\*.pst>%userprofile%\desktop\pstpaths.txt，在命令提示下将为您提供一个列表。感谢您的响应。输出到文本文件现在只显示.mdc文件，缺少.pst文件。您还可以帮助将文件大小输出转换为KB。size返回文件大小（以字节为单位）。要转换为KB，只需除以1024 2^10即可。上述更改不应影响写入的文件。我们仍在迭代objNS.Folders集合，就像您最初做的那样。感谢您的回复。我本以为相同的引用会迭代odjNS.Folders，但它只显示一行，.mdc文件。我将下面的GetPSTPath=MidstrPath，InStrstrPath，：\-1更改为GetPSTPath=MidstrPath，InStrstrPath，：\+1，然后所有文件都显示在文本文件中，但路径的开头被截断，没有C:等。