附件数量跳过签名中的图片(基于objAttachments.Item.s.Size)

问题描述 投票:0回答:1

我正在尝试创建一个代码,该代码将解析Outlook中的“收件箱”文件夹并根据多个条件来组织电子邮件。

  1. 如果方括号之间有数字。例如(123456)
  2. 如果电子邮件中有附件。附件应大于10000以跳过签名]

逻辑:

  • 如果两个条件都匹配->发送到Folder1
  • 如果其中之一不匹配(附件丢失或括号之间没有数字,请发送至存档

条件1运行正常,但是在添加附件条件2时遇到问题。

这是我当前的代码:

Private Sub olInboxMainItems_ItemAdd(ByVal Item As Object)

    'On Error Resume Next

    Dim SubjectVar1 As String
    Dim openPos1 As Integer
    Dim closePos1 As Integer
    Dim midBit1 As String
    Dim objNamespace1 As Outlook.NameSpace
    Dim destinationFolder1 As Outlook.MAPIFolder
    Dim ArchiveFolder As Outlook.MAPIFolder
    Dim objAttachments As Outlook.Attachments
    Dim AttCount As Long

    Set objNamespace1 = GetNamespace("MAPI")
    Set destinationFolder1 = objNamespace1.Folders("[email protected]").Folders("Inbox").Folders("Folder1")
    Set ArchiveFolder = objNamespace1.Folders("[email protected]").Folders("Archive")

    Set objAttachments = Item.Attachments

    ' Check is there a number between brackets
    SubjectVar1 = Item.Subject
    openPos1 = InStr(SubjectVar1, "(")
    closePos1 = InStr(SubjectVar1, ")")
    midBit1 = Mid(SubjectVar1, openPos1 + 1, closePos1 - openPos1 - 1)

    ' Count number of attachments bigger than 10000 bytes
    For s = lngCount To 1 Step -1
      If objAttachments.Item(s).Size > 10000 Then

        ' Count attachments.
        AttCount = objAttachments.Item(s).Count

      End If
    Next s

    ' Perform actions
    If midBit1 = "" And AttCount < 1 Then
        Item.Move ArchiveFolder
        'GoTo EndOfScript
    Else
        'MsgBox (midBit)
        Item.Move destinationFolder1
        'GoTo EndOfScript
    End If

EndOfScript:

    Set destinationFolder1 = Nothing
    Set objNamespace1 = Nothing

End Sub

编辑:

这里是一个简单的版本,我正在尝试处理选定的电子邮件:

Sub CountAttachmentsinSelectedEmails()

    Dim olSel As Selection
    Dim oMail As Object
    Dim s As Long
    Dim AttCount As Long
    Dim strMsg As String
    Dim nRes
    Dim lngCount As Long
    Dim objAttachments As Outlook.Attachments
    Dim strFile As String

    Set olSel = Outlook.Application.ActiveExplorer.Selection

    For Each oMail In olSel

        For s = lngCount To 1 Step -1
        If objAttachments.Item(s).Size > 10000 Then

            ' Get the file name.
            strFile = objAttachments.Item(s).Count + 1

         End If
         Next s

    Next

    MsgBox ("There are " & strFile & " attachments in the ")

End Sub

结果为空?完全没有数字

vba outlook outlook-vba
1个回答
1
投票

[Item.Attachments是一个集合,因此objAttachments也是如此。

一个集合可以有零个或多个成员。 objAttachments.Count是您未检查的成员数。

您需要遍历附件以分别检查其大小和扩展名。签名,徽标等可以算作附件,但我认为您对它们不感兴趣。会有不止一个有趣的附件吗?您是否希望总大小为10,000或任何一个附件超过10,000个字节?

访问大小时,需要指定要检查的附件:objAttachments.Item(Index).Size

以上内容应为您提供一些指导,但如有必要,我可以详细解释。

© www.soinside.com 2019 - 2024. All rights reserved.