求高手修正，邮件附件加不上，且老是提示警示框。

yh9824 · 发表于 2014-6-18 21:33

1、是附件加不上，2是警示框提示，我公司outlook信任中心那里是灰色的，没办法，求高手修正。

发邮件.zip (46.55 KB, 下载次数: 1)

Dim myfilename, a, b, addf As String, n As Integer
myfilename = "D:\日报邮件文件夹\日报邮件.xlsm"
                  Workbooks.Open Filename:=myfilename
Range("e6") = " D:\日报邮件文件夹\日报邮件.xlsm"
addf = Range("e6").Value
finalrow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
On Error Resume Next
Dim endRowNo
Dim objoutlook, objmail As Object
Set objoutlook = CreateObject("outlook.application")
Set objmail = objmail.CreateItem(0)
For n = 5 To finalrow
Workbooks("发邮件.xlsm").Activate
Sheets("邮件地址").Select
Set objmail = objoutlook.CreateItem(olMailItem)
With objmail
      .To = Cells(n, 3).Value
      .from = "yanha@ss-express.com"
      .Subject = Cells(n, 2).Value & "收到请删除，试试程序发邮件呢"
      .body = Cells(n, 4).Value
      .Attachments.add addf
      .Display
      .DoEvents
      .SendKeys "%s", True
      .Send
End With
      Set objmail = Nothing
  Next
      Set objoutlook = Nothing
End Sub

闻启学 · 发表于 2014-6-19 11:21

帮你远程一下

联系我 QQ：417149126

yh9824 · 发表于 2014-6-23 23:44

我的问题还是没有解决哦，哪位高手可以帮我。

dsd999 · 发表于 2014-6-26 10:01

1）把  Range("e6") = " D:\日报邮件文件夹\日报邮件.xlsm"  D:前的空格去掉。
2）Set objmail = objmail.CreateItem(0)  这句肯定是有问题的，删掉。
3）把  On Error Resume Next 这句注释，看还有什么问题，只有没问题后，再把注释打开。

闻启学 · 发表于 2014-6-26 10:44

dsd999 发表于 2014-6-26 10:01
1）把 Range("e6") = " D:\日报邮件文件夹\日报邮件.xlsm" D:前的空格去掉。
2）Set objmail = objmail. ...

他是提示那个邮件中带有附件的提示框

是否允许的

这个是怎样处理版主

yh9824 · 发表于 2014-7-5 17:18

dsd999 发表于 2014-6-26 10:01
1）把 Range("e6") = " D:\日报邮件文件夹\日报邮件.xlsm" D:前的空格去掉。
2）Set objmail = objmail. ...

谢谢，确实是那个空格的在作怪，附件可以发出了，只是那个提示框看怎么可以不提示！

yh9824 · 发表于 2014-7-5 17:19

dsd999 发表于 2014-6-26 10:01
1）把 Range("e6") = " D:\日报邮件文件夹\日报邮件.xlsm" D:前的空格去掉。
2）Set objmail = objmail. ...

谢谢，
如何不出现提示框呢

		自动登录	找回密码
密码			免费注册