office 2016下.Attachments.Count 失效

crime

我原来用的是OFFICE 2010

可以准确判断是否存在附件
如果没有
就不发送

但是现在换成2016之后，这句话失效了
也就是说，无论有没有附件，他都判断是1

求助
顺便附上我的代码

1. Sub 群发工资邮件()
   
2. 
   
3. '先通过VBA窗口"工具"菜单--"引用"选择 "Microsoft outlook 11.0 object Library
   
4. '已在Outlook中设置可发送邮件的正常帐号
   
5. 
   
6. On Error Resume Next
   
7. 
   
8. Dim objOutlook As New Outlook.Application
   
9. Dim objMail As MailItem
   
10. Dim strbody As String
    
11. 
    
12. '"创建objO为Outlook应用程序对象
    
13. 
    
14. Set objO = New Outlook.Application
    
15. 
    
16. '"创建objMail为一个邮件对象
    
17. '"设置收件人地址(以下邮件的信息皆从EXCEL工件表的字段中获得)
    
18. '"设置邮件主题
    
19. 
    
20. 
    
21. For i = [q5] To [q6]
    
22.           [q2] = i
    
23.    Set objMail = objOutlook.CreateItem(olMailItem)
    
24.    
    
25.    strbody = Cells(2, 15)
    
26.    
    
27.    With objMail
    
28.      .To = Cells(2, 13)
    
29.      If Cells(2, 13) > 0 Then
    
30.      .Subject = Cells(2, 1)
    
31.      '.Body = Cells(2, 15)
    
32.      .HTMLBody = "<Font Face=微软雅黑 Size=4.5 color=#1F497D'>您好，</font>" & _
    
33.      "<BR><Font Face=微软雅黑 Size=3.5 color=#1F497D'>" & strbody & "</font></BR>" & _
    
34.      "<BR><Font Face=微软雅黑 Size=3.5 color=#1F497D'>请查收。</font></BR>" & _
    
35.      "<BR></BR>" & _
    
36.      "<BR></BR>" & _
    
37.      "<BR><Font Face=微软雅黑 Size=3.5 color=#1F497D'>XX室</font></BR>"     '使用HTML格式的正文"
    
38. 
    
39.    '"设置附件
    
40.         fj = "'" + Cells(2, 14) + "'" / 为字符串字段加上引号
    
41.         .Display
    
42.         .Attachments.Add Sheets("群发").Cells(2, 14).Value
    
43. 
    
44. '发送邮件
    
45. 
    
46.     If <font color="Red">.Attachments.Count > 0</font> Then
    
47.     .Send
    
48.     Else
    
49.     Application.SendKeys "%{F4}n"
    
50.     MsgBox Cells(2, 18) & " " & Cells(3, 16) & "  无附件，未发送"
    
51.     End If
    
52.     Else
    
53.     MsgBox Cells(2, 18) & " " & Cells(3, 16) & "  无地址，未发送"
    
54.     End If
    
55. 
    
56.    End With
    
57.    Set objMail = Nothing
    
58. Next
    
59. Set objOutlook = Nothing
    
60. End Sub
    
61. 
    

复制代码

谢谢