【问题标题】:Run-time error '-2147352567(80020009)': cannot parse condition. Error at "SQL="urn:schemas:httpmail:datereceived"..."运行时错误“-2147352567(80020009)”:无法解析条件。 "SQL="urn:schemas:httpmail:datereceived" 处出错..."
【发布时间】:2018-07-27 14:34:10
【问题描述】:

我正在尝试根据我有限的知识修改现有代码以满足我的需求。我已经根据 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' 和 " & _ Chr(34) & "urn:schemas:httpmail:datereceived" & _ Chr(34) & "

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

【问题讨论】:

  • 在代码块中添加源代码

标签: vba outlook


【解决方案1】:

为什么在源文件夹中的 each 迭代中循环遍历目标文件夹中的 所有 项?先保存附件,再移动项目

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

【讨论】:

  • 感谢 Dmitry,我已使用上述建议更新了 VBA 代码,但它不会保存附件,而是将我的电子邮件移动到邮箱中名为“已过滤”的文件夹中。另外,我需要使用字符串 StartDate 和 EndDate 输入日期,它会得到我的输入,但它不适用。
【解决方案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

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2016-04-13
    • 1970-01-01
    • 2020-07-22
    • 1970-01-01
    相关资源
    最近更新 更多