Question

我有一个运行的Excel宏，并生成一个挂在学生笔记本电脑上的文档，这些笔记本电脑需要维修，该文档还会通过电子邮件发送帮助台，该系统会在系统中创建具有相同详细信息的工作（或部分细节无论如何）。

使用的笔记本电脑已升级到Windows 8.1，并从Outlook 2010升级到Outlook 2013。该脚本用于处理旧系统，但是由于升级到新系统后主题不再填充，即使鼠标悬停在其上的变量“主题”，也会显示应输入的文本。

下面的脚本：

    Sub Next_Loan()
'
' Next_Loan Macro
' Macro recorded 18/05/2011
'
' Keyboard Shortcut: Ctrl+n
'
Sheets("Sheet1").Select
    Range("D4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]="""",RC[3],VLOOKUP(RC[-2],Sheet2!R[-3]:R[65532],2,FALSE))"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-3]="""",CONCATENATE(RC[3],""@eq.edu.au""),VLOOKUP(RC[-3],Sheet2!R[-3]:R[65532],3,FALSE))"
    Range("F4").Select




    ActiveCell.FormulaR1C1 = "=NOW()"
    Range("A4:F4").Select
    Range("F4").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("4:4").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown
    Range("L4").Font.Color = RGB(211, 211, 211)


'    ActiveWindow.SmallScroll Down:=-9
    Sheets("Sheet3").Select
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "=Sheet1!R5C4"
    Range("D6").Select
    ActiveCell.FormulaR1C1 = "=Sheet1!R5C5"
    Range("D7").Select
    ActiveCell.FormulaR1C1 = "=Sheet1!R5C6"
    Range("D10").Select
    ActiveCell.FormulaR1C1 = "=Sheet1!R5C3"
    ActiveCell.Offset(-5, 0).Range("A1:B9").Select


    Sheets("Sheet3").Select
    Range("D4:D20").Select
    ActiveSheet.PageSetup.PrintArea = "$D$4:$D$20"
    ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,1,,,TRUE,,FALSE)"
    Sheets("Sheet1").Select
    Range("A4").Select

'
'Sub Mail_Selection_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
    Dim rng As Range
    Dim subject As Range
    Dim OutApp As Object
    Dim OutMail As Object
Sheets("Sheet4").Select
Range("B2:B10").Select
    Set rng = Nothing
    Set subject = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    'Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a range if you want
    Set rng = Sheets("Sheet4").Range("B1:B10").SpecialCells(xlCellTypeVisible)
'    Set subject = Sheets("Sheet4").Range("B2").SpecialCells(xlCellTypeVisible)
    Set subject = Sheets("Sheet4").Range("B2")
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    If subject Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If


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

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

    On Error Resume Next
    With OutMail
        .To = "EmailGoesHere"
        .CC = ""
        .BCC = ""
        .subject = subject
        .HTMLBody = RangetoHTML(rng)
        .display
'        .Send   'or use .Display
    End With
    On Error GoTo 0

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

    Set OutMail = Nothing
    Set OutApp = Nothing
    Sheets("Sheet1").Select
    Range("A4").Select

     'Clear contents of Sheet 1 I5 and L5 (Cell Phone Number and Student Password after printing ticket)
Range("I5").ClearContents
Range("L5").ClearContents
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"

    '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

其他一切似乎都在起作用......我迷失了想法，我已经在网上搜索脚本试试......仍然没有。

任何帮助表示赞赏

进一步说明：

我确实注意到了，如果

Set subject = Sheets("Sheet4").Range("B2").SpecialCells(xlCellTypeVisible)

使用

，它不会复制Sheet4，B2中的文本，但是如果你删除了.SpecialCells（xlCellTypeVisible），那么它会将值复制到变量中...前者在以前版本的Excel中工作。

以上两者现在都不会将值复制到电子邮件的主题字段中。

如果我将'subject'变量更改为双引号字符串，它会将字符串插入到主题字段中，因此出于某种原因，它不喜欢变量，或者我的语法不正确？

Answer 1

[编辑：已添加.Value到范围]您的代码正在尝试将邮件属性“Subject”（键入为字符串）设置为定义为“Range”的变量。 VBA会尝试将一种类型强制转换为另一种类型，但它并不总是正确的，您的结果有时可能是不可预测的。我要么将变量'subject'的数据类型更改为String并从单元格B2中获取值，或者只是更改以下行：

.subject = subject

到

.subject = Worksheets("Sheet4").Range("B2").Value

Excel VBA无法将变量插入Outlook电子邮件主题字段

1 个答案: