excel - 仅从共享工作簿发送一次自动电子邮件
问题描述
我有代码可以在一天中的特定时间通过电子邮件将 Sheet1 的内容发送到分发列表。
这是一个共享工作簿,因此多个用户可以同时打开它。
该代码多次发送电子邮件,来自同一用户或多个用户作为电子邮件中的“发件人”。我假设是因为多个用户打开了文件。
我怎样才能只发送一次电子邮件?
Sheet1 在电子邮件正文中发送:
Sub Email()
'Worksheets("Sheet1").Unprotect Password:="1"
Dim ChartName1 As String
Dim dataTable As String
Dim rng As Range
Set appOutlook = CreateObject("outlook.application")
'create a new message
Set Message = appOutlook.CreateItem(olMailItem)
Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
'Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a fixed range if you want
Set rng = Sheets("Sheet1").Range("A1:E11").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
ChartName1 = Environ$("temp") & "\Chart1.gif"
ActiveWorkbook.Worksheets("Sheet1").ChartObjects("Chart 1").Chart.Export _
Filename:=ChartName1, FilterName:="GIF"
With Message
.Subject = " Files status " & Format(Date, "dd/mm/yyyy")
.HTMLBody = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=2>" _
& "Dear all,<br ><br >Please see below the Open Files status for today : " _
& "<br><BR>"
.HTMLBody = .HTMLBody & rangetoHTML(rng) & "<br>"
.HTMLBody = .HTMLBody & "<html><body><img src=" & "'" & ChartName1 & "'><Br><Br><Br/></body></html>"
' .HTMLBody = .HTMLBody & "<br><B>WEEKLY REPPORT:</B><br>" _
' & "<br>Best Regards,<br>Ed</font></span>"
.To = "recipients here "
.Cc = ""
.Display
.Send
End With
Kill ChartName1
Set OutMail = Nothing
Set OutApp = Nothing
'Worksheets("Sheet1").Protect Password:="1"
End Sub
以图片形式发送图表的功能:
Function rangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
rangetoHTML = ts.readall
ts.Close
rangetoHTML = Replace(rangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
每天上午 09:05 发送文件的代码,包含在 ThisWorkbook 中
Private Sub Workbook_Open()
Application.OnTime TimeValue("09:05:00"), "Email"
End Sub
解决方案
如果您可以选择一个用户,则应从其中执行宏,在调用该过程之前,您可以根据以下内容检查该用户:
If Application.UserName = "username" Then
希望它可能有用。
推荐阅读
- javascript - div内的位置菜单图标
- android - android模拟器WHPX:无法模拟MMIO访问,退出代码3
- variables - 如何从变量中正确获取 gulp.src glob?
- javascript - 英雄滑块图像未显示全宽
- python - 添加一个值并使用 Notepad++ 求和
- sql - 我需要能够为 250 万条记录生成非重复的 8 字符随机字母数字
- javascript - 为什么我的 v-for 不能正常工作,显示一个数字而不是应有的几个
- javascript - 在自己的行上开始和结束标记 - vue html更漂亮
- android - Android:总是使用 postInvalidate() 而不是 invalidate() 有缺点吗?
- laravel - 模块构建失败:TypeError:this.setDynamic 不是函数