电子邮件宏在2010年但不在2013年?

时间:2015-04-08 16:39:11

标签: excel vba

此代码在2010年有效,但现在它在2013年不起作用,它用于弹出一个新窗口,显示输入到我的Excel工作表中的信息。我不确定为什么它不能正常工作,有时候代码会起作用,有时它不会。没有多大意义。我希望有人可以看看,看看会发生什么。

Sub Email()    Dim Bytedata()  As Byte
Dim HTMLcode    As String
Dim HTMLfile    As Object
Dim olApp       As Object
Dim TempFile    As String
Dim Wks         As Worksheet


    Set Wks = ActiveSheet


    Set Range_To_Send = Wks.Range("A1:G29")

    TempFile = Environ("Temp") & "\Temp Email.htm"

        Set olApp = CreateObject("Outlook.Application")

        With Wks.Parent.PublishObjects
            .Add(SourceType:=xlSourceRange, _
                Filename:=TempFile, Sheet:=Wks.Name, _
                Source:=Range_To_Send.Address, HtmlType:=xlHtmlStatic) _
            .Publish Create:=True
        End With

        Open TempFile For Binary Access Read As #1
            ReDim Bytedata(LOF(1))
            Get #1, , Bytedata
        Close #1

        HTMLcode = StrConv(Bytedata, vbUnicode)

        HTMLcode = VBA.Replace(HTMLcode, "align=center x:publishsource=", "align=left x:publishsource=")

        olApp.Session.getdefaultFolder 6

        With olApp.CreateItem(olMailItem)
            Select Case Range("B2")
            Case "A"
            .To = ThisWorkbook.Sheets("A").Range("A1").Value
            Case "B"
            .To = ThisWorkbook.Sheets("B").Range("A1").Value
            Case "C"
            .To = ThisWorkbook.Sheets("C").Range("A1").Value
            Case "D"
            .To = ThisWorkbook.Sheets("D").Range("A1").Value
            Case "E"
            .To = ThisWorkbook.Sheets("E").Range("A1").Value
            Case "F"
            .To = ThisWorkbook.Sheets("F").Range("A1").Value
            Case "G"
            .To = ThisWorkbook.Sheets("G").Range("A1").Value
            End Select
            .cc = "service_djdh@yahoo.com"
            If InStr(Time, "AM") > 0 Then
            .Subject = "AM"
            Else
            .Subject = "PM"
            End If
            .BodyFormat = 2
            .HTMLBody = HTMLcode
            .Display
        End With

    Kill TempFile
    Wks.Parent.PublishObjects.Delete
    Range("B11").Value = ""
    Range("B17").Value = ""
    Range("B18").Value = ""
    Range("B19").Value = ""
    Range("B20").Value = ""
    Range("B12").Value = ""
    Range("B22").Value = ""
    Range("B50").Value = "0"
    Range("B51").Value = "0"
    End Sub

它说有一个错误并带我到这个代码:

            .Add(SourceType:=xlSourceRange, _                    Filename:=TempFile, Sheet:=Wks.Name, _
                Source:=Range_To_Send.Address, HtmlType:=xlHtmlStatic) _
            .Publish Create:=True

1 个答案:

答案 0 :(得分:1)

我将在这里作为答案抛出我的评论:

Source:=Range_To_Send.Address更改为

Source:=Range_To_Send.Address(External:=True)

我猜这就是答案。我认为它与Excel 2013切换到“单文档界面”有关,这意味着每个工作簿都在自己的窗口中,因为Word已经存在了一段时间。最近在一些涉及windows的VBA上工作时,我注意到每个窗口似乎都有一个单独的Application对象。我不确定这是否准确,但它提示上面的答案,它完全标识了工作簿路径,在可能有助于应用程序之间通信的理论下。

我很高兴我猜对了,它解决了你的问题。