none
VBA codes from Excel cells to to outlook RRS feed

  • Question

  • Hi Guys,

    I am currently working on codes to send excel sheets from outlook email. This was easily done. :)

    The problem here is that i want to copy paste a range of cells in the body of message (email) as PICTURE. Need urgent help. Need codes for that. couldn't find it on internet. :(

    Thanks in Advance,

    Wasimali

    Friday, June 5, 2015 10:59 AM

Answers

  • That is fairly straightforward if you have Outlook e.g.

    Option Explicit
    
    Sub Test()
    Dim strText As String
        strText = "This is the message text" & vbCr & vbCr
        EMailRange xlRng:=Range("MyRange"), _
                   strTo:="someone@somewhere.com", _
                   strSubject:="This is the subject", _
                   strMessage:=strText
    End Sub
    
    Sub EMailRange(xlRng As Range, _
                   strTo As String, _
                   strSubject As String, _
                   strMessage As String)
    'G.Mayor - 5 June 2015
    Dim oOutlookApp As Object
    Dim oItem As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
    
        xlRng.CopyPicture xlScreen, xlBitmap
        On Error Resume Next
        'Get Outlook if it's running
        Set oOutlookApp = GetObject(, "Outlook.Application")
    
        'Outlook wasn't running, start it from code
        If Err <> 0 Then
            MsgBox "Start Outlook first!"
            GoTo lbl_Exit
        End If
    
        'Create a new mailitem
        Set oItem = oOutlookApp.CreateItem(0)
        With oItem
            .BodyFormat = 2
            .To = strTo
            .Subject = strSubject
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.collapse 1
            oRng.Text = strMessage
            oRng.collapse 0
            oRng.Paste
            .Display
            '.Send 'Resurrect after testing
        End With
    
        'Clean up
        Set oItem = Nothing
        Set oOutlookApp = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
    lbl_Exit:
        Exit Sub
    End Sub
    
    




    Graham Mayor - Word MVP
    www.gmayor.com


    Friday, June 5, 2015 12:58 PM