Vba 统计签名中跳过图片的附件数（基于对象附件.项目.大小）

我正在尝试创建一个代码来解析Outlook中的收件箱文件夹，并根据几个标准组织电子邮件

如果括号之间有数字。例如（123456）

如果电子邮件项目中有附件。附件应大于10000以跳过签名

逻辑：

• 如果两个条件都匹配->发送到文件夹1
• 如果其中一个不匹配（缺少附件或括号之间没有数字），请发送到存档

条件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("mybox@mail.com").Folders("Inbox").Folders("Folder1")
    Set ArchiveFolder = objNamespace1.Folders("mybox@mail.com").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

结果是空的吗？根本没有数字

---

编辑2:

Sub CountAttachmentsinSelectEmails()

    Dim olSel As Selection
    Dim oMail As Object
    Dim s As Long
    Dim objAttachments As Outlook.Attachments
    Dim NumFiles As Long
    Dim oItem As Object

    Set olSel = Outlook.Application.ActiveExplorer.Selection
    Set objAttachments = oItem.Attachments

    For Each oMail In olSel

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

                NumFiles = NumFiles + 1

             End If
         Next s

    Next

    Debug.Print NumFiles

End Sub

---

项。附件是一个集合，因此
对象附件也是一个集合

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

您需要在附件上循环以分别检查其大小和扩展。签名、徽标等都算作附件，但我认为您对它们不感兴趣。会有不止一个有趣的附件吗？是否希望总大小为10000或任何一个附件超过10000字节

访问大小时，需要指定要检查的附件：
objAttachments.Item（Index）.size

以上内容你应该给你一些建议，但如果有必要，我可以更详细地解释

关于编辑1的评论

您不会将
objaAttachments
设置为任何内容。添加
Set objAttachments=oItem.Attachments

在s=lngCount To 1步骤-1的
中，您没有将
lngCount
设置为一个值，因此它默认为零，并且永远不会执行For正文。尝试对s=objAttachments执行
。计数到1步-1

strFile
是一个字符串，但您正在数字表达式中使用它。这将起作用，因为解释器将计算表达式，然后将其转换为字符串。但是，该值为
objAttachments.Item.Count+1
。如果有五个附件，且其中任何一个大于10000字节，则答案为六个

您需要像
Dim NumFiles一样长的文件
。这将被初始化为0。在
If
中，您需要
NumFiles=NumFiles+1

我很少使用MsgBox进行诊断。我发现
Debug.Print NumFiles
更方便。如果要停止执行，请使用
Debug.Assert False

编辑2的评论

这是我用来测试新电子邮件处理宏的例行程序。与此相关的是，它显示了如何正确使用Outlook的资源管理器

Sub TestNewMacro()

  ' Skeleton for testing a new mail item processing macro using Explorer
  ' Replace statement marked ##### with call of new macro.
  ' Add code to create parameters for new test macro and remove any code to
  ' create parameters for old test macro.

  Dim Exp As Explorer
  Dim ItemCrnt As MailItem
  Dim PathSave As String

  ' Technique for locating desktop from answer by Kyle:
  '                     http://stackoverflow.com/a/17551579/973283
  PathSave = CreateObject("WScript.Shell").SpecialFolders("Desktop")

  Set Exp = Outlook.Application.ActiveExplorer

  If Exp.Selection.Count = 0 Then
    Call MsgBox("Please select one or more emails then try again", vbOKOnly)
    Exit Sub
  Else
    For Each ItemCrnt In Exp.Selection
      Call MacroToBeTested(ItemCrnt, PathSave)  ' #####
    Next
  End If

End Sub

/您的代码有什么问题？这会显示一条错误消息，提示“参数不是可选的”，指向
objAttachments.Item.Size
中的项，请以后始终发布错误消息谢谢！我的目的是让代码统计电子邮件中超过10000字节的附件数量。然后我可以简单地检查计数数是否大于1，执行操作。如果<1，请执行另一个操作，欢迎使用。如果你需要一些示例代码，尽管问吧。我已经用简单的代码添加了我的第二次尝试，但效果并不理想。若你们能给我一些建议，告诉我如何让编辑部分的代码正常工作，那个就太好了，因为仍然有一些错误。O_O我添加了edit2，您可能会发现它很有用。这个答案包括我用来诊断电子邮件处理宏问题的宏。宏将选定的属性输出到即时窗口，或将我感兴趣的所有属性输出到文件。您目前可能不需要诊断宏，但可能对宏访问附件属性的方式感兴趣。
Sub TestNewMacro()

  ' Skeleton for testing a new mail item processing macro using Explorer
  ' Replace statement marked ##### with call of new macro.
  ' Add code to create parameters for new test macro and remove any code to
  ' create parameters for old test macro.

  Dim Exp As Explorer
  Dim ItemCrnt As MailItem
  Dim PathSave As String

  ' Technique for locating desktop from answer by Kyle:
  '                     http://stackoverflow.com/a/17551579/973283
  PathSave = CreateObject("WScript.Shell").SpecialFolders("Desktop")

  Set Exp = Outlook.Application.ActiveExplorer

  If Exp.Selection.Count = 0 Then
    Call MsgBox("Please select one or more emails then try again", vbOKOnly)
    Exit Sub
  Else
    For Each ItemCrnt In Exp.Selection
      Call MacroToBeTested(ItemCrnt, PathSave)  ' #####
    Next
  End If

End Sub