Question

我正在尝试以我有限的知识来修改现有代码以满足我的要求。我已根据Dmitry的建议自定义了代码，从而将附件保存到计算机的目标文件夹中。但是使用startdate和enddate字符串获取变量日期低于错误

运行时错误'-2147352567（80020009）'：

无法解析条件。错误出现在“ SQL =“ urn：schemas：httpmail：datereceived” ...“。

确切发生在Set myRestrictItems = myItems.Restrict（Filter）

上的错误

但它可以与直接日期配合使用

Filter =“ @ SQL =”＆Chr（34）＆“ urn：schemas：httpmail：datereceived”＆_ Chr（34）＆“> = '01 / 01/2017'And”＆_ Chr（34）和“ urn：schemas：httpmail：datereceived”＆_ Chr（34）＆“ <'28 / 07/2018'”

Sub Extract()

Dim valid As Boolean: valid = True
Dim oShell As Object
Dim Filter As String
Dim myNamespace As Outlook.NameSpace
Dim myRestrictItems As Outlook.Items
Dim myItems As Outlook.Items
Dim myItem As Object
Dim i As Long
Dim oAttachment As Outlook.Attachment
Dim StartDate, EndDate As String

Set myNamespace = Application.GetNamespace("MAPI")

Set myFolder = myNamespace.PickFolder

Set myItems = myFolder.Items

StartDate = InputBox("Enter the Start Date in dd/mm/yyyy format", vbOKOnly)
EndDate = InputBox("Enter the End Date in dd/mm/yyyy format", vbOKOnly)

Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " >= " & StartDate & _
Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " <= " & EndDate & ""


Set myRestrictItems = myItems.Restrict(Filter)

strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)

strFolderpath = strFolderpath & "\Attachments\"

For i = myRestrictItems.Count To 1 Step -1

Set myItem = myRestrictItems(i)

    For Each oAttachment In myItem.Attachments

        oAttachment.SaveAsFile strFolderpath & oAttachment.FileName

    Next

   Next

End Sub

Answer 1

为什么要遍历源文件夹中每次迭代的目标文件夹中的所有项目？首先保存附件，然后移动项目

For i = myRestrictItems.Count To 1 Step -1
   set myItem = myRestrictItems(i)
   for each oAttachment in myItem.Attachments
     oAttachment.SaveAsFile objDestinationFolder & oAttachment.FileName
   next
   myItem.Move myDestFolder
Next

Answer 2

我找到了上述运行时错误的答案，即以字符串形式提取日期，我将其再次转换为日期格式，然后输入到值中，从而修复了错误消息。这是最终代码。

Sub Extract()

Dim valid As Boolean: valid = True
Dim oShell As Object
Dim Filter As String
Dim myNamespace As Outlook.NameSpace
Dim myRestrictItems As Outlook.Items
Dim myItems As Outlook.Items
Dim myItem As Object
Dim i As Long
Dim oAttachment As Outlook.Attachment
Dim StartDate, EndDate As String


Set myNamespace = Application.GetNamespace("MAPI")

Set myFolder = myNamespace.PickFolder

Set myItems = myFolder.Items

StartDate = InputBox("Enter the Start Date in dd/mm/yyyy format", vbOKOnly)
EndDate = InputBox("Enter the End Date in dd/mm/yyyy format", vbOKOnly)

StartDate = "'" & Format(StartDate, "Short Date") & "'"
EndDate = "'" & Format(EndDate, "Short Date") & "'"

eFilter = "@SQL= (urn:schemas:httpmail:datereceived >= " & StartDate & _
      " And urn:schemas:httpmail:datereceived <= " & EndDate & ")"


Set myRestrictItems = myItems.Restrict(eFilter)

strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)

strFolderpath = strFolderpath & "\Attachments\"

For i = myRestrictItems.Count To 1 Step -1

Set myItem = myRestrictItems(i)

    For Each oAttachment In myItem.Attachments

            oAttachment.SaveAsFile strFolderpath & Format(i, "000#") & "_" & oAttachment.FileName
        Next
    Next

 End Sub

运行时错误'-2147352567（80020009）'：无法解析条件。错误出现在“ SQL =“ urn：schemas：httpmail：datereceived” ...“

2 个答案: