Outlook功能不再有效

我目前正在使用Windows 7和Office 2010.我有一個在Outlook中創建和發送電子郵件的舊宏。它使用了一個函數（見下文）來創建電子郵件的主體。它一直在工作，但我在Office 2010中遇到問題。該宏從數據文件複製信息並粘貼到宏中的其他工作表中。當它創建電子郵件時，它會將數據複製到一個新手冊中。然後它調用這個函數來創建電子郵件的主體。當宏命中下面這行（ERROR HAPPENS HERE）時，它會退出該功能並繼續創建和發送電子郵件，但電子郵件中沒有主體。有關這行代碼有什麼問題的任何建議將不勝感激。謝謝你的幫助........Outlook功能不再有效

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

來源

2017-07-18 Shaves

請不用理會這個問題，因爲我找出了錯誤。一旦變量沒有任何數據，那麼該字段是空白的。一旦我確定變量有數據，代碼就會按預期運行。 – Shaves

請你忽視這個問題，因爲我找出了什麼是錯的。一旦變量沒有任何數據，那麼該字段是空白的。一旦我確定變量有數據，代碼就會按預期運行。

來源

2017-07-18 19:59:11 Shaves

Outlook功能不再有效

回答

相關問題