none
Trying to cut and paste an image from excel to my email, it is working, just not right RRS feed

  • Question

  • Well, this one is interesting. So I have this template that loads up items from a sharepoint list, and then I do things with the items.

    One of the things that I need to do is to be able to take a screen shot of the excel doc, attach it to an email, and send it out. The thing is that I am using a template excel doc that sits in a folder on a shared drive. From this template I create reports everyday. This part works fine, it is just the cut and paste issue, it seems that the way this is working is that it will only take the screen shot from the template document and add it to the template document, not the one that I just created, which is what need.

    Anyway, my code:
        run_date = Date
        Dim s2 As String
        s2 = Format(run_date, "MM-dd-yyyy")
        Dim FS As Object

    Dim FullPath As String
    FullPath = "\\path\Report\Reports\Status Reports\Daily\DailyReportStatusFor" + s2 + ".xlsm"

            Set objXL = CreateObject("Excel.Application")
            objXL.DisplayAlerts = False
            objXL.Application.Workbooks.Open FullPath
            Set objActiveWkbk = objXL.Application.ActiveWorkbook

    ' Where you will enter Sharepoint location path
        objXL.Application.Workbooks.Open FullPath

                objXL.ActiveWorkbook.SaveAs Filename:= _
                    "https://Sharepoint/lists/shared documents/DailyReportStatusFor" + s2 + ".xlsm", FileFormat:=1, CreateBackup:=False


       Range("'owssvr'!A1:O18").CopyPicture
       Sheets("Image").Select
       Range("A1").Select
       ActiveSheet.Paste

    Dim objOLApp As Object    'Outlook.Application
    Dim outItem As Object    'Outlook.MailItem
    Dim outFolder As Object    'MAPIFolder
    Dim DestFolder As Object    'MAPIFolder
    Dim outNameSpace As Object    'NameSpace
    Dim lngAttachment As Long
    SendFrom = "me@me.com"
    SendTo = "me@me.com"

     ccTo = "me@me.com"
    EmailSubject = "Dashboard - Daily Review Status for " + s2
    EmailBody = "Attached is the  Dashboard - Daily Review Status for " + s2
    'Set application settings
    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    Sheets("Image").Select
    Range("A1").Select
    Set Sendrng = Selection
    With Sendrng

    ActiveWorkbook.EnvelopeVisible = False
    With .Parent.MailEnvelope
    With .Item

    .Subject = EmailSubject
    .To = SendTo
    .CC = ccTo
    .SentOnBehalfOfName = SendFrom    
    .Attachments.Add ("\\Path to report\Report\Reports\Status Reports\Daily\DailyReportStatusFor" + s2 + ".xlsm")
    .Body = "Attached is the Dashboard - Daily Review Status for " + s2
    .Send
    End With
    End With
    'Outlook_SendEmail = True
    End With
         objXL.ActiveWorkbook.Close SaveChanges:=False


       ' objXL.Application.COMAddIns("AmericanExpress.ExcelMetadataAddin").Connect = True
        objXL.DisplayAlerts = True
        Set objActiveWkbk = Nothing
        objXL.Application.Quit
        Set objXL = Nothing
        Set objNet = Nothing
        Set FS = Nothing
        Set App = Nothing
        Set Itm = Nothing
        End Sub


    Best regards, Mike

    Wednesday, June 22, 2016 5:36 PM

Answers

All replies