vbscript未使用兑换访问收件箱中的outlook 2013/2016子文件夹

时间:2017-03-21 18:26:39

标签: vbscript outlook outlook-redemption

我在outlook 2013/2016上运行以下vbscript,并且尝试在收件箱中的子文件夹中阅读电子邮件时遇到问题。我可以阅读收件箱电子邮件。 。有人能指出我正确的方向吗?

提前谢谢。

Function CheckMail(strMailBox,strFolder,strFolderAbbr,strDetails)
    '
    olFolderInbox = 6
    set Session = CreateObject("Redemption.RDOSession")
    '
    Set objOutlook = CreateObject("Outlook.Application")
    Session.MAPIOBJECT = objOutlook.Session.MAPIOBJECT
    set Store = Session.Stores.GetSharedMailbox(strMailBox)
    set Inbox = Store.GetDefaultFolder(olFolderInbox)
    '
    Wscript.Echo "MailBox: " & Store.Name & " - " & Inbox.Name

    If strFolder = "" then
        set SubFolder = Inbox
        strFolderAbbr = strMailBox & " Inbox"
    Else
        'set SubFolder = Inbox.Folders(strFolder)
        '
        set SubFolder = Inbox.Folders.Item(strFolder)
        '
        strFolderAbbr = strMailBox & " Inbox\" & strFolder
        Wscript.Echo " Sub Folder: " & SubFolder
    End If
    '

    nItems  = SubFolder.Items.Count
    If nHowlong > 1 Then
        nHowlong = Round((nItems/110)/60,0)
        strTime = " Hour(s)!!"
    Else
        nHowlong = Round(nItems/110,0)
        strTime = " Minute(s)!!"
    End If
    Wscript.Echo nItems & " - Emails in folder " & strFolderAbbr  & " About " & nHowlong & strTime
    '"  -  " & nItems
    '       
    for each Msg in SubFolder.Items
        nCounter = nCounter + 1
        'Wscript.Echo "Item " & nCounter & "/" & nItems & vbCRLF & "EID: " & Msg.EntryID  & vbCRLF & "ABOUT: " & Msg.Subject & vbCRLF & "FROM: " & Msg.SenderName & vbCRLF & "LEVEL: " & IIf(Msg.Importance=2,"High",IIf(Msg.Importance=1,"Normal","Low")) & vbCRLF  & "Status: " & IIf(Msg.UnRead, "Not Read", "Read") & vbCRLF & "Received: " & Msg.ReceivedTime & vbCRLF & "Body: " & Msg.Body
        '& nCounter & "/" & nItems & vbCRLF & "EID: " & Msg.EntryID  & vbCRLF & "ABOUT: " & Msg.Subject & vbCRLF & "FROM: " & Msg.SenderName & vbCRLF & "LEVEL: " & IIf(Msg.Importance=2,"High",IIf(Msg.Importance=1,"Normal","Low")) & vbCRLF  & "Status: " & IIf(Msg.UnRead, "Not Read", "Read") & vbCRLF & "Received: " & Msg.ReceivedTime & vbCRLF & "Body: " & Msg.Body
        '
        ' process all emails in the box
        strRecords = strRecords & "REG-" &strFolderAbbr & "~" &  Msg.Subject & "~" &  Msg.ReceivedTime & "~" & IIf(Msg.UnRead, "Not Read", "Read") & "~" & Msg.SenderName & "~" &IIf(Msg.Importance=2,"High",IIf(Msg.Importance=1,"Normal","Low")) & "*"
        On Error Resume Next
    err.clear
        if Err Then
            'WScript.Echo "ReceivedTime was null"
        End If
        On Error GoTo 0
    next

    CheckMail = strRecords
End Function

Function IIf(bClause, sTrue, sFalse)
    If CBool(bClause) Then
        IIf = sTrue
    Else 
        IIf = sFalse
    End If
End Function

1 个答案:

答案 0 :(得分:0)

我终于找到了有效的代码。我首先要感谢德米特里给予我的所有帮助。但这是一个顽固的问题。以下代码解决了这个问题。请不要让我解释它只是简单的运气和追踪和错误。

set Session = CreateObject("Redemption.RDOSession")
    Set objOutlook = CreateObject("Outlook.Application")
    Session.MAPIOBJECT = objOutlook.Session.MAPIOBJECT
'Set Root foldedr of the mail box of the stores
    set IPMRoot = Session.Stores.Item(strMailBox).IPMRootFolder 
'Set the subfolder to the inbox
    If strFolder = "" then
        set subFolder = IPMRoot.Folders("InBox")
        strFolderAbbr = strMailBox & " Inbox"
    Else
'Set subfolder to subfolder chosen
        set subFolder = IPMRoot.Folders("InBox").Folders(strFolder)
        strFolderAbbr = strMailBox & " Inbox\" & strFolder
    End If
    '