excel vba调用outlook将当前excel文件作为附件发送邮件

琬心婆婆 · 发表于 2012-9-5 21:41

如题。我想在这张表里加一个按钮，点击按钮就能调用outlook将当前的这个excel文件作为附件发送一封邮件。邮件的收件人是一个邮箱，抄送是另一个邮箱，主题是“XXX表格”，正文是“XXX表格已完成，请查收。”请教这个该怎么做，高手帮帮忙，我总是配不对outlook。

XXX表格.rar (1.45 KB, 下载次数: 34) 求高手帮忙！！

wcymiss · 发表于 2012-9-5 23:04

Sub outlook发送()
'工具-引用勾选Microsoft outlook
'要预先对outlook进行配置
Dim myOlApp As New Outlook.Application
With myOlApp.CreateItem(olMailItem)
.Attachments.Add ThisWorkbook.FullName '附件
.To = "******@**" '邮箱地址
.Subject = "XXX表格" '主题
.Body = "XXX表格已完成，请查收。" '正文
.cc = "*******@****" '抄送
.send '发送
End With
Set myOlApp = Nothing
End Sub

复制代码

PGLOBAL · 发表于 2013-11-1 22:58

wcymiss 发表于 2012-9-5 23:04

亲你好
我直接复制粘贴了你的编码然后F5 但是木有成功唉
弹出窗口
user defined type not defined...
是不是有什么地方要改的？不是直接复制就能用？
谢拉

KCFONG · 发表于 2013-11-2 11:58

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
      On Error Resume Next
      With OutMail
         .To = "******@**" '邮箱地址
      .Subject = "XXX表格" '主题
      .Body = "XXX表格已完成，请查收。" '正文
      .cc = "*******@****" '抄送
         .Attachments.Add ThisWorkbook.FullName '附件
            .Display
            .Save
      End With
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "%{s}", True 'send the email without prompts
      On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

迷者问禅 · 发表于 2017-12-4 16:22

KCFONG 发表于 2013-11-2 11:58
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Applicat ...

666，很6啊

-z- · 发表于 2018-8-17 15:55

wcymiss 发表于 2012-9-5 23:04

如果是将附件的地址写在工作表中，该如何写代码呢？
、

weisilisid · 发表于 2018-8-17 20:33

-z- 发表于 2018-8-17 15:55
如果是将附件的地址写在工作表中，该如何写代码呢？
、

attach_address = ThisWorkbook.Sheets("sheet1").Range("a1") '指定附件路径
.Attachments.Add attach_address '指定要添加附件，可以多次重复，添加多个附件

-z- · 发表于 2018-8-20 14:48

weisilisid 发表于 2018-8-17 20:33
attach_address = ThisWorkbook.Sheets("sheet1").Range("a1") '指定附件路径
.Attachments.Add attach_ ...

With objMail
'设置收件人地址（从通讯录表的'E-mail地址'字段中获得）
.To = Cells(rowCount, 1)
' 加抄送
.cc = Cells(rowCount, 2)
'设置邮件主题
.Subject = Cells(rowCount, 3)
'设置邮件内容（从通讯录表的'内容'字段中获得）
.Body = Cells(rowCount, 4)
'设置附件（从通讯录表的'附件'字段中获得）
.Attachments.Add Cells(rowCount, 5)
'自动发送邮件
.send
End With

复制代码

我是用这个循环在工作表中获取信息（邮件地址、主题等）创建邮件的，发邮件没问题，但就是附件无法加上上去，不知道是什么问题。

-z- · 发表于 2018-8-20 14:51

weisilisid 发表于 2018-8-17 20:33
attach_address = ThisWorkbook.Sheets("sheet1").Range("a1") '指定附件路径
.Attachments.Add attach_ ...

.Attachments.Add Cells(rowCount, 5)
我用这个代码获取写在工作表第五列的附件地址，但邮件就是带不上附件，怎么回事呢？

weisilisid · 发表于 2018-8-21 07:31

有可能是你的表格附件路径描述不清楚吧？最好能上附件看看

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

[求助] excel vba调用outlook将当前excel文件作为附件发送邮件