Question

我正在尝试导出特定文件夹中的所有电子邮件＆＃34;未执行操作DO＆＃34;到CSV文件然后将这些电子邮件移动到另一个文件夹＆＃34;操作DO＆＃34;。

我编辑了我找到的代码。

只有最后一封电子邮件保存在csv文件中。

我需要所有电子邮件都在同一个CSV文件中。

Sub PseudoArchive()
Dim objNamespace As Outlook.NameSpace
Dim sourceFolder As Outlook.MAPIFolder
Dim destinationFolder As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim Item As Object
Dim msg As String
Dim i As Long

Set objNamespace = GetNamespace("MAPI")
Set sourceFolder = objNamespace.Folders("msroumi@hotmail.com").Folders("Inbox").Folders("Not Actioned DO")
Set destinationFolder = objNamespace.Folders("msroumi@hotmail.com").Folders("Inbox").Folders("Actioned DO")
Set Items = sourceFolder.Items

'Move emails in sourceFolder to destinationFolder
msg = Items.Count & " Items in " & sourceFolder.Name & ", Move?"

If MsgBox(msg, vbYesNo) = vbYes Then
    For i = Items.Count To 1 Step -1
        Set Item = Items.Item(i)
        DoEvents
        Item.Move destinationFolder

        Item.SaveAs "D:\Excel\Learning Excel VBA\Outlook VBA\MyEmail.txt", olTXT
    Next
End If
End Sub

Answer 1

首先，您在物品已被移动（并删除）后进行扫描。在调用Move之前调用SaveAs 。或使用Move函数的返回值重置项目：set Item = Item.Move destinationFolder。

然而，最重要的是，您使用相同的文件名保存所有邮件，不断覆盖旧文件，因此只有最后一个文件存活。使文件名唯一 - 你可以使用消息Subject属性（确保删除所有无效字符，例如":"）或者你可以做一些简单的事情，如添加计数器到te hfile名称：

Item.SaveAs "D:\Excel\Learning Excel VBA\Outlook VBA\MyEmail" & i & ".txt", olTXT

将多个电子邮件导出到一个csv文件

1 个答案: