Question

我在Internet上发现了一些用于列出Outlook配置文件信息的代码，我想这样做，但它给出了错误：类型不匹配：'[string：“A”]'，第74行（代码800A000D）。我不知道为什么它不起作用。

这是代码：

    Option Explicit 
    Const HKEY_CURRENT_USER = &H80000001 
    Const r_PSTGuidLocation = "01023d00" 
    Const r_MasterConfig = "01023d0e" 
    Const r_PSTCheckFile = "00033009" 
    Const r_PSTFile = "001f6700" 
    Const r_keyMaster = "9207f3e0a3b11019908b08002b2a56c2" 
    Const r_ProfilesRoot = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging    Subsystem\Profiles" 
    Const r_DefaultProfileString = "DefaultProfile" 
    Dim oReg:Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") 
  Dim arrSubKeys, subkey, strValue, i, pstFile, arrPSTs, DefaultProfileName  

  oReg.GetStringValue HKEY_CURRENT_USER,r_ProfilesRoot,r_DefaultProfileString,DefaultProfileName 
  GetPSTsForProfile(DefaultProfileName)  
  '_____________________________________________________________________________________________________________________________ 
 Function GetPSTsForProfile(p_profileName)
 Dim strHexNumber, strPSTGuid, strFoundPST

 oReg.GetBinaryValue HKEY_CURRENT_USER,r_ProfilesRoot & "\" & p_profileName & "\" & r_keyMaster,r_MasterConfig,strValue
 If IsUsableArray (strValue) Then
 For Each i In strValue
 If Len(Hex(i)) = 1 Then 
 strHexNumber = CInt("0") & Hex(i)
 Else
 strHexNumber = Hex(i)
 End If        
 strPSTGuid = strPSTGuid + strHexNumber
 If Len(strPSTGuid) = 32 Then 
 If IsAPST(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid) Then
 Wscript.Echo PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & _
 PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid))
 End If    
 strPSTGuid = ""
 End If            
 Next
 End If
 End Function
 '______________ 
  '_____________________________________________________________________________________________________________________________
Function GetSize(zFile) 
Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
dim objFile:Set objFile = objFSO.GetFile(zFile)
GetSize = ConvertSize(objFile.Size)
End Function 
'_____________________________________________________________________________________________________________________________
Function ConvertSize(Size) 
Do While InStr(Size,",") 'Remove commas from size     
CommaLocate = InStr(Size,",")     
Size = Mid(Size,1,CommaLocate - 1) & _         
Mid(Size,CommaLocate + 1,Len(Size) - CommaLocate) 
Loop
Dim Suffix:Suffix = " Bytes" 
If Size >= 1024 Then suffix = " KB" 
If Size >= 1048576 Then suffix = " MB" 
If Size >= 1073741824 Then suffix = " GB" 
If Size >= 1099511627776 Then suffix = " TB" 
Select Case Suffix    
Case " KB" Size = Round(Size / 1024, 1)     
Case " MB" Size = Round(Size / 1048576, 1)     
Case " GB" Size = Round(Size / 1073741824, 1)     
Case " TB" Size = Round(Size / 1099511627776, 1) 
End Select
    ConvertSize = Size & Suffix 

End Function
'_____________________________________________________________________________________________________________________________ 
Function IsAPST(p_PSTGuid) 
Dim x, P_PSTGuildValue 
Dim P_PSTCheck:P_PSTCheck=0 
IsAPST=False 
oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTCheckFile,P_PSTGuildValue 
If IsUsableArray (P_PSTGuildValue) Then
For Each x in (P_PSTGuildValue)
P_PSTCheck = P_PSTCheck + Hex(x) 
Next 
End If 
If P_PSTCheck=20 Then IsAPST=True 
End Function  
'_____________________________________________________________________________________________________________________________
 Function PSTlocation(p_PSTGuid)
 Dim y, P_PSTGuildValue
 oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTGuidLocation,P_PSTGuildValue
 If IsUsableArray (P_PSTGuildValue) Then
 For Each y In P_PSTGuildValue
 If Len(Hex(y)) = 1 Then
 PSTlocation = PSTlocation & CInt("0") & Hex(y)
 Else
 PSTlocation = PSTlocation & Hex(y)
 End If    
 Next
 End If
 End Function  
'_____________________________________________________________________________________________________________________________ 
 Function PSTFileName(p_PSTGuid)
 Dim z, P_PSTName
 Dim strString : strString = ""
 oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTFile,P_PSTName
 If IsUsableArray (P_PSTName) Then
 For Each z in P_PSTName
 If z > 0 Then strString = strString & Chr(z)
 Next
 End If
 PSTFileName = strString
 End Function  
'_________________________________________________________________________________________________________
 Function ExpandEvnVariable(ExpandThis) 
 Dim objWSHShell:Set objWSHShell = CreateObject("WScript.Shell") 
 ExpandEvnVariable = objWSHShell.ExpandEnvironmentStrings("%" & ExpandThis & "%") 
 End Function
 '_________________________________________________________________________________________________________ 
 Function IsUsableArray(rvnt)'-- Use this function to test for a Null, Empty or an undimensioned array.'-- Useful b/c some interfaces can hold properties for which if they have a'-- value will be an Array but may also be Null or an undimensioned Array.
'-- It assumes that a Null or Empty could potentially be an array but not yet dimensioned. '-- It returns -1 if it is passed a string, long, etc...'-- It returns 0 for an empty array or the number of elements in the first dimension.
 IsUsableArray = 0
 If (VarType(rvnt) And 8192) = 8192 Then 
 IsUsableArray = UBound(rvnt) - LBound(rvnt) + 1 
 Else
 If Not (IsEmpty(rvnt) Or IsNull(rvnt)) Then IsUsableArray = -1 
 End If
 End Function

Answer 1

如果我更正了第8行的额外空间，该脚本可以在我的系统上运行（Windows Messaging Subsystem）这是一个很大的脚本，它提供了什么，请参阅这里的较小的脚本，提供更多使用免费下载库{Redemption http://www.dimastr.com/redemption/home.htm，这是CDO应该是。

set Session = CreateObject("Redemption.RDOSession")
const skUnknown = 0, olStoreANSI = 1, olStoreUnicode = 2, skPrimaryExchangeMailbox = 3, skPublicFolders = 5, skDelegateExchangeMailbox = 4

Session.Logon
for each Store in Session.Stores
  if (Store.StoreKind = olStoreANSI) then
    wscript.echo Store.Name & " - " & Store.PstPath & " " & Store.Name
  elseif (Store.StoreKind = olStoreUnicode) Then
    wscript.echo Store.Name & " - " & Store.PstPath
  ElseIf (Store.StoreKind = skPrimaryExchangeMailbox) or (Store.StoreKind = skDelegateExchangeMailbox) or (Store.StoreKind = skPublicFolders) Then
    wscript.echo Store.Name & " - " & Store.ServerDN
  Else 
    wscript.echo Store.Name & " - "  & Store.StoreKind
  End If
next

用于列出Outlook配置文件信息的VBS脚本

1 个答案: