Question

我得到一个项目，可以进入收件箱中的特定文件夹。进入文件夹后，我必须解压缩附件并将电子邮件正文另存为文本文件。完成此操作后，我需要将这两封邮件附加到电子邮件上，以将其发送到附加了文件监视程序的另一个邮箱（Mailbox2）。

发送到Mailbox2后，尝试将电子邮件移动到另一个文件夹时遇到问题

def hello(a):
    if a == 0:
        return
        |            # | is the current cursor position.

我一直在尝试的是将此逻辑嵌入到Application_NewMail（）的for循环中

-------------------------------------
Private Sub Application_NewMail()


Dim NS As Outlook.NameSpace
Set NS = Outlook.Application.GetNamespace("MAPI")

Dim Inbox As Folder
Set Inbox = NS.GetDefaultFolder(olFolderInbox)

Dim SubFolder As Folder
Set SubFolder = Inbox.Folders("TESTER")


Dim Destination As String
Destination = "MyFolder\"


Dim Atmt As Attachment
Dim FileName As String
Dim Subject As String
Dim txtFile As String


For Each Email In SubFolder.Items
    For Each Atmt In Email.Attachments
        If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
            FileName = Destination & Email.SenderName & " " & Atmt.FileName
            Atmt.SaveAsFile FileName
            I = I + 1
        End If
    Next Atmt

    Subject = Email.SenderName

    Dim rmv As Variant
    rmv = Array("\", "/", ":", "*", "?", """", "<", ">", "|")

    Dim r As Variant 

    For Each r In rmv 
        Subject = Replace(Subject, r, "")
    Next r

    txtFile = Destination & Subject & ".txt"

    Open txtFile For Output As #1
        Write #1, Email.Body
    Close #1

    Call Send_Mail(Subject)
    Call DeleteExample
Next Email

End Sub
-------------------------------------
Public Sub Send_Mail(Subject As String)
  Dim OutlookApp As Outlook.Application
  Dim OutlookMail As Outlook.MailItem
  Set OutlookApp = New Outlook.Application
  Set OutlookMail = OutlookApp.CreateItem(olMailItem)
  StrPath = "MyFolder\"

  With OutlookMail
  .Display
    .To = "Mailbox2@gmail.com"
    .CC = "Mailbox2@gmail.com"
    .BCC = "Mailbox2@gmail.com"
    .Subject = "Test mail"
    strfile = Dir(StrPath & "*.*")
    Do While Len(strfile) > 0
        If (Right(strfile, 3) = "txt" Or Right(strfile, 3) = "pdf" Or Right(strfile, 4) = "xlsx") Then
            .Attachments.Add StrPath & strfile
        End If
    strfile = Dir
    Loop
    .Send
  End With
End Sub
-------------------------------------
Sub DeleteExample()
'Deletes all files in the folder
    Kill "MyFolder\*.*"
End Sub
-------------------------------------

它正在做什么，就是将整个“ TESTER”文件夹移到“ END”文件夹

Answer 1

进一步处理之后，我发现了如何将电子邮件移动到其他文件夹。

这是逻辑

Sub MoveEmail()
Dim NS As Outlook.NameSpace
Set NS = Outlook.Application.GetNamespace("MAPI")

Dim Inbox As Folder
Set Inbox = NS.GetDefaultFolder(olFolderInbox)

Dim SubFolder As Folder
Set SubFolder = Inbox.Folders("TESTER")

   For Each Email In SubFolder.Items
      Email.Move (Inbox.Folders("END"))
   Next Email


End Sub

Answer 2

在修改集合时不要使用“ for each”-使用下循环：

set items = SubFolder.Items
for i = items.Count to 1 step -1
  set Email = items(i)
  Email.Move (Inbox.Folders("END"))
Next

Excel VBA-将电子邮件移动到其他文件夹

2 个答案: