Outlook 功能不再有效
Outlook function no longer works
我目前正在使用 Windows 7 和 Office 2010。我有一个旧的宏,它在 Outlook 中创建和发送电子邮件。它使用一个函数(如下)来创建电子邮件的正文。它一直在工作,但我在让它在 Office 2010 中工作时遇到了问题。宏从数据文件复制信息并粘贴到宏中的不同工作表中。在创建电子邮件时,它会将数据复制到新的工作簿中。然后它调用此函数来创建电子邮件的正文。当宏命中下面的行时(此处发生错误),它会退出函数并继续创建和发送电子邮件,但电子邮件中没有正文。任何关于这行代码有什么问题的建议将不胜感激。感谢您的帮助.......
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"
' TempFile = "C:\temp" & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
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
With TempWB.PublishObjects.Add( _ ' error happens here
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
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=")
TempWB.Close SaveChanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
请无视这个问题,我已经弄明白哪里出了问题。有一次变量没有任何数据,因此该字段为空白。一旦我确定变量有数据,代码 运行 就如预期的那样。
我目前正在使用 Windows 7 和 Office 2010。我有一个旧的宏,它在 Outlook 中创建和发送电子邮件。它使用一个函数(如下)来创建电子邮件的正文。它一直在工作,但我在让它在 Office 2010 中工作时遇到了问题。宏从数据文件复制信息并粘贴到宏中的不同工作表中。在创建电子邮件时,它会将数据复制到新的工作簿中。然后它调用此函数来创建电子邮件的正文。当宏命中下面的行时(此处发生错误),它会退出函数并继续创建和发送电子邮件,但电子邮件中没有正文。任何关于这行代码有什么问题的建议将不胜感激。感谢您的帮助.......
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"
' TempFile = "C:\temp" & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
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
With TempWB.PublishObjects.Add( _ ' error happens here
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
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=")
TempWB.Close SaveChanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
请无视这个问题,我已经弄明白哪里出了问题。有一次变量没有任何数据,因此该字段为空白。一旦我确定变量有数据,代码 运行 就如预期的那样。