0

我有一个 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 中工作。

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

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

4

1 回答 1

2

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

.subject = subject

至

.subject = Worksheets("Sheet4").Range("B2").Value
于 2014-11-11T15:52:12.287 回答