关于发送邮件时获取自动生成附件名称问题

ilssan · 发表于 2019-1-18 14:40

各位老师好，目前我将EXCEL表内的报表生成PDF文件，文件名称是固定名称加自动获取的生成日期和时间，（比如某某报表-201901191215130721），请问我应如何获取该PDF文件名称作为附件发送邮件，

ilssan · 发表于 2019-1-18 15:37

不好意思，没写完就发出去了。附上简略的说明表，麻烦各位老师看看里面的代码。目前邮件能发送成功，但不能携带附件。另外，显示有多少报表发送成功的数量也不正确。
谢谢了

ilssan · 发表于 2019-1-18 15:39

如果我把名字定成固定的，不加后面的日期时间是可以成功发送邮件的。目前就卡在这个文件名，和统计发送数量上。

闻启学 · 发表于 2019-1-18 20:07

代码有几个问题，
1 无添加outlook 引用
2，思路不明确

'*******************************************************************'
'程序名称：最完美的利用EXCEL自动批量发送邮件
'
'经测试在OUTLOOK 2000中不会显示警告窗口.
'引用：Microseft Outlook *.0 Object Library
'需要注意一点 , 邮件的标题, 否则不能自动放送!
'**********************************************************************
Sub 批量发送邮件()
'复制申报文件夹里的报表PDF到存档文件夹
Dim Fso As Object
Dim 当前路径 As String, 目标路径 As String
当前路径 = "E:\A\1" & "\*.pdf" '复制PDF文件路径
目标路径 = "E:\A\2" '目标路径
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile 当前路径, 目标路径
Set Fso = Nothingm
Dim i As Integer
'清空报表文件夹
Kill "E:\A\2\*.*"
'新生成一个PDF格式的附件
ActiveSheet.ExportAsFixedFormat xlTypePDF, "E:\A\2" & "" & Sheets("报表输出").Range("A2").Text & "-" & VBA.Format(VBA.Now, "yyyymmddhhmmss")
'附件设置
'获取附件名称
Dim mypath As String, n%, myfile As String '定义变量
mypath = "E:\A\1" '文件/夹所在路径
n = 1
myfile = Dir(mypath & "\*.*") '提取文件路径中的所有文件，此时返回第一个文件的名字
'要能正确发送并需要对Microseft Outlook进行有效配置
On Error Resume Next
Dim rowCount, endRowNo
'要正常运行下面这句,要将工具/引用中的Microseft Outlook *.0 Object Library(其中*为你Microseft Outlook的版本号)选上
Dim objOutlook As New Outlook.Application
Dim objMail As MailItem
'取得当前工作表与邮件列表Cells(1,1)相连的数据区行数
endRowNo = Sheets("邮件列表").Cells(1, 1).CurrentRegion.Rows.Count
'创建objOutlook为Outlook应用程序对象
Set objOutlook = New Outlook.Application
'开始循环发送电子邮件
For rowCount = 2 To endRowNo
'创建objMail为一个邮件对象
Set objMail = objOutlook.CreateItem(olMailItem)
With objMail
'设置收件人地址（从通讯录表的'E-mail地址'字段中获得）
.To = Sheets("邮件列表").Cells(rowCount, 1)
'设置邮件主题
.Subject = Sheets("邮件列表").Cells(rowCount, 2)
'设置邮件内容（从通讯录表的'内容'字段中获得）
.Body = Sheets("邮件列表").Cells(rowCount, 3)
'设置附件（从通讯录表的'附件'字段中获得）
'.Attachments.Add ("E:\一周工作\6废弃物仓库工作\台账报表\报表申报\危险废弃物库存量报告表.pdf")
'.Attachments.Add Sheets("邮件列表").Cells(rowCount, 4)
.Attachments.Add (myfile)
'自动发送邮件
.Send
End With
'销毁objMail对象
Set objMail = Nothing
i = i + 1
Next
'延时5秒
Application.Wait (Now + TimeValue("00:00:05"))
'销毁objOutlook对象
Set objOutlook = Nothing
'所有电子邮件发送完成时提示
MsgBox "一共" & i & "份报表发送成功！"
'暂时不关闭EXCEL
'If Application.Workbooks.Count = 1 Then
'Application.Quit
'Else
'Workbooks("TEST.xlsm").Close
'End If
'
End Sub

复制代码

闻启学 · 发表于 2019-1-18 20:09

漏了一句上面代码无测试的电脑系统在更新中无Outlook

cj9687451 · 发表于 2019-1-20 01:21

闻启学发表于 2019-1-18 20:09
漏了一句上面代码无测试的电脑系统在更新中无Outlook

闻老师，为何我在outlook已经设置了开启宏，点选宏后还是找不到宏名呢？

闻启学 · 发表于 2019-1-20 09:03

cj9687451 发表于 2019-1-20 01:21
闻老师，为何我在outlook已经设置了开启宏，点选宏后还是找不到宏名呢？

你代码放在哪里模块？？、

zpy2 · 发表于 2019-1-20 09:22

闻启学发表于 2019-1-20 09:03
你代码放在哪里模块？？、

测试在OUTLOOK 2000中不会显示警告窗口.
真的没有警告窗口吗？我是2003，咋有啊？

闻启学 · 发表于 2019-1-20 10:28

楼上你所指的是

cj9687451 · 发表于 2019-1-20 13:25

闻启学发表于 2019-1-20 09:03
你代码放在哪里模块？？、

原来完成宏设置后，要退出outlook再进才能进行宏运行。已经解决了，谢谢关心。

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

[求助] 关于发送邮件时获取自动生成附件名称问题

评分