复制范围并作为 Outlook 电子邮件正文发送答案

【问题标题】：copy range and send as outlook email body复制范围并作为 Outlook 电子邮件正文发送
【发布时间】：2020-02-07 02:44:45
【问题描述】：

我有下面的 VBA 代码来复制 Excel 中的范围并将其作为 Outlook 中的电子邮件正文发送。 excel表格保存在服务器中，它在我的电脑和其他一些电脑/笔记本电脑上也能正常工作。但它给其他一些用户带来了编译错误。所有用户都连接到同一个网络并使用相同版本的 Outlook 和 Excel 2016。

编译错误 - 找不到项目或库

当我单击从同事（用户）的其他计算机运行此脚本的命令按钮时，错误出现在提到的行（此处错误）。 Outlook 和 excel 都是 2016。我在参考菜单中添加了 Outlook 对象库。 Excel 工作表位于服务器文件夹 \\hp-fs2\Groups\H&P ISM\Navigational Assessment 非常感谢本论坛专家提供的任何修改代码的解决方案。

Private Sub CommandButton1_Click()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Sheet1.Unprotect ("so")
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Sheet1").Range("B9:I22").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = "abcdg@abcd.com"
    .CC = ""
    .BCC = ""
    .Subject = "This is Automatic Notification - Navigation Assessment Overview sheet has just been updated !"
    .HTMLBody = RangetoHTML(rng)
    '.Send
    .display
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

Sheet1.Protect ("so")
End Sub

Function RangetoHTML(rng As Range)

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"

'( ERROR HERE - at the line TempFile = Environ$ )

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 used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

【问题讨论】：

我认为如果您无法添加 Outlook 参考 tbh，您可能会遇到困难
将 Outlook 对象模型类型库引用添加到您的项目中，使用早期绑定的优点（留给自己！），并且不要使用该库中定义的任何常量（声明并使用而是您自己的副本）；然后当它工作时，删除引用并将声明从Outlook.Something 更改回Object，没有人会注意到您使用早期绑定引用构建它。不过，“运行时错误”相当令人惊讶。您确定没有与错误相关的错误号吗？ 438？还有更有意义的错误信息？哪一行报错了？
@Mat'sMug - 抱歉回复晚了，生病了。编译错误“找不到项目或库”出现在下面提到的行中。 TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 。但它不会在我的电脑和我的一些同事连接到网络的笔记本电脑中出错。它只会在某些也连接到同一网络的人身上出现此错误。我们所有人都在使用连接到一个网络的本地 PC 和笔记本电脑。此 Excel 表位于路径 \\hp-fs2\Groups\H&P ISM\Nav_Audit
@Mat'sMug - 我现在也添加了 Outlook 参考。

标签： excel vba

【解决方案1】：

我对临时文件感兴趣...也许其他用户没有适当的凭据来保存到他们计算机上的 Environ$？或者 Environ$ 是否指向某个受限的网络位置？

我敢打赌，如果您在用户计算机上的 My Documents\yourproject\temp（或类似的）下生成临时文件，这个问题就会消失。

【讨论】：