CODEWITHSUNDEEP
excelvba
IFeelYourPain
IFeelYourPain

Reputation: 1

Email Macro works in 2010 but not 2013?

This code worked in 2010, but now it doesn't work in 2013, it use to pop up a new window which displayed my info inputted into my excel worksheet. I'm not quiet sure why it's not working, and sometimes the code will work, and sometimes it won't. Doesn't make much sense. I was hoping someone could take a look and see what's going on.

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 = "[email protected]"
            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

It says there is an error and takes me to this code:

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

Upvotes: 0

Views: 105

Answers (1)

Doug Glancy
Doug Glancy

Reputation: 27478

I'm going to throw my comment up here as an answer:

Change Source:=Range_To_Send.Address to

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

I was guessing that was the answer. I think it has to do with Excel 2013 switching to the "Single Document Interface," which means each workbook is in its own window, as Word has been for a while. While working recently on some VBA that involved windows, I noticed that each window seems to have a separate Application object. I'm not sure is that's accurate, but it prompted the answer above, which fully identifies the workbook path, under the theory that might help communication between applications.

I'm glad I guessed right and that it solved your problem.

Upvotes: 1

Related Questions