Проблема с модулем класса Outlook VBA - PullRequest
0 голосов
/ 02 января 2019

Я новичок в VBA и пытаюсь вставить модуль класса, чтобы сохранить сообщение электронной почты, которое поступает в подпапку в папке «Мои папки» с именем «Моя папка», в папку на общем диске. У меня есть приведенный ниже код, и я пытался отправить электронные письма для тестирования, но он не работает и не могу понять, почему. Любая помощь будет принята с благодарностью!

Private WithEvents InboxItems As Outlook.Items
Sub Application_Startup()
Dim xNameSpace As Outlook.NameSpace
Set xNameSpace = Outlook.Application.Session
Set InboxItems = xNameSpace.GetDefaultFolder(olFolderInbox)
Set InboxItems = olFolder.Folders("My Folder")
End Sub

Private Sub InboxItems_ItemAdd(ByVal objItem As Object)
Dim FSO
Dim xMailItem As Outlook.MailItem
Dim xFilePath As String
Dim xRegEx
Dim xFileName As String
On Error Resume Next
xFilePath = CreateObject("WScript.Shell").SpecialFolders(16)
xFilePath = xFilePath & "File Path on Share Drive will be entered here"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(xFilePath) = False Then
FSO.CreateFolder (xFilePath)
End If
Set xRegEx = CreateObject("vbscript.regexp")
xRegEx.Global = True
xRegEx.IgnoreCase = False
xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"
If objItem.Class = olMail Then
Set xMailItem = objItem
xFileName = xRegEx.Replace(xMailItem.Subject, "")
xMailItem.SaveAs xFilePath & "\" & xFileName & ".msg", olMSG
End If
Exit Sub
End Sub

1 Ответ

0 голосов
/ 03 января 2019

Было несколько проблем с кодом, который я видел.У меня это работает, убедитесь, что вы добавили это к ThisOutlookSession объекту в VBA IDE.

Private WithEvents InboxItems As Outlook.Items

Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application: Set outlookApp = Outlook.Application
    Dim objectNS As Outlook.NameSpace: Set objectNS = outlookApp.GetNamespace("MAPI")
    Set InboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub InboxItems_ItemAdd(ByVal Item As Object)
    Dim FolderPath      As String: FolderPath = "YOUR PATH HERE"
    Dim FileName        As String
    Static FSO          As Object

    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(FolderPath) = False Then FSO.CreateFolder FolderPath

    With CreateObject("vbscript.regexp")
        .Global = True
        .IgnoreCase = False
        .Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"

        If Item.Class = olMail Then
            FileName = .Replace(Item.Subject, vbNullString)
            Item.SaveAs FolderPath & FileName & ".msg", olMSG
        End If

    End With

End Sub
...