周六,01 2018月
  0 回复
  2.6K访问
0
投票
解开
我安装了 kutools 来协助工作项目。 我还管理一个大型公司报告,该报告有一个宏,可以根据输入的信息创建电子邮件。 该宏已停止在我的计算机上运行。 它适用于没有 kutools 的计算机。 有没有人遇到过这样的事情? 这是在其他计算机上运行良好的宏:

子 Mail_Sheet_Outlook_Body()
'在 Excel 2000-2016 中工作
应用程序.ReferenceStyle = xlA1
调光范围
将 OutApp 调暗为对象
将 OutMail 作为对象变暗
将 xFolder 调暗为字符串
将 xSht 调暗为工作表
将 xSub 调暗为字符串
暗淡响应为字符串
将消息调暗为字符串
暗淡风格作为字符串
暗淡标题为字符串

设置 xSht = ActiveSheet
Msg = "您确定要通过电子邮件发送此表单吗?" ' 定义消息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定义按钮。
Title = "电子邮件发送确认" ' 定义标题。
响应 = 消息框(消息,样式)

如果响应 = vbYes 那么
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "商店的现场审核" + CStr(xSht.Cells(19, "A").Value)
有应用程序
.EnableEvents = 假
.ScreenUpdating = 假
结束

设置 rng = 无
设置 rng = ActiveSheet.UsedRange
'您也可以使用工作表名称
'设置 rng = Sheets("YourSheet").UsedRange

设置 OutApp = CreateObject("Outlook.Application")
设置 OutMail = OutApp.CreateItem(0)
Dim varCellvalue 只要




出错时继续下一步
使用 OutMail
.To = ""
.CC =“”
.BCC =“”
.Subject = "回顾"
.Attachments.Add x文件夹
.HTMLBody = RangetoHTML(rng)
.Display '或使用 .Display

结束
出错时转到 0

有应用程序
.EnableEvents = 真
.ScreenUpdating = True
结束

设置 OutMail = 无
设置 OutApp = 无
结束如果
END SUB


函数 RangetoHTML(rng As Range)
' 在 Office 2000-2016 工作
将 fso 调暗为对象
调暗为对象
将 TempFile 调暗为字符串
将 TempWB 调暗为工作簿

TempFile = Environ$("temp") & "\" & Format(现在,"dd-mm-yy h-mm-ss") & ".htm"

'复制范围并创建一个新工作簿以将数据过去
rng.复制
设置 TempWB = Workbooks.Add(1)
使用 TempWB.Sheets(1)
.Cells(1).PasteSpecial 粘贴:=8
.Cells(1).PasteSpecial xlPasteValues, , False, 假
.Cells(1).PasteSpecial xlPasteFormats, , False, 假
.Cells(1).选择
Application.CutCopyMode = False
出错时继续下一步
.DrawingObjects.Visible = True
.DrawingObjects.删除
出错时转到 0
结束

'将工作表发布到 htm 文件
使用 TempWB.PublishObjects.Add(_
来源类型:=xlSourceRange,_
文件名:=临时文件,_
工作表:=TempWB.Sheets(1).名称,_
来源:=TempWB.Sheets(1).UsedRange.Address,_
HtmlType:=xlHtmlStatic)
.发布(真)
结束

'将htm文件中的所有数据读入RangetoHTML
设置fso = CreateObject(“ Scripting.FileSystemObject”)
设置 ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.关闭
RangetoHTML = 替换(RangetoHTML, "align=center x:publishsource=", _
“对齐=左x:发布源=”)

'关闭温度WB
TempWB.Close 保存更改:=False

'删除我们在这个函数中使用的htm文件
杀死临时文件
设置 ts = 无
设置 fso = 无
设置 TempWB = 无

函数结束
目前还没有回复。