Outlook and Excel

dave3009

Well-known Member
Joined
Jun 23, 2006
Messages
7,035
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
  2. Mobile
  3. Web
Hi Folks

I have managed to conjure up some code that will copy the current sheet from a given workbook, paste it to it's very own workbook, save it then e-mail it via Outlook.

see my code

Code:
Sub testpastecode()
Dim iTemp As Long
Dim Fpath, CrName As String
iTemp = Application.SheetsInNewWorkbook
Fpath = ThisWorkbook.Path
CrName = ThisWorkbook.Name
Application.SheetsInNewWorkbook = 1
Workbooks.Add
ActiveWorkbook.SaveAs Fpath & "\Report.xls"
Workbooks(CrName).ActiveSheet.Cells.Copy
Application.DisplayAlerts = False
With ActiveWorkbook
    .ActiveSheet.PasteSpecial
    .ActiveSheet.Name = Workbooks(CrName).ActiveSheet.Name
    .ActiveSheet.Range("A1").Select
    .Save
    .SendMail Recipients:="Dave3009"
End With
Application.DisplayAlerts = True
Application.SheetsInNewWorkbook = iTemp
Application.CutCopyMode = False

End Sub

Now this works, my only issue is that I get prompted if I want to Allow or Deny Outlook to send it. Ideally I'd want to just Allow as the end users are button pressers and may panic given an option.

In the above code I tried DisplayAlerts but that didn't do the trick.

Any help is much appreciated

Thanks


Dave


p.s. If I could save the file with the name Report plus a date time stamp I'd be doubly thankful
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

dave3009

Well-known Member
Joined
Jun 23, 2006
Messages
7,035
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
  2. Mobile
  3. Web
OK so I did some seraching and came up with this but I still get the Outlook security message, is this maybe an Outlook issue?

Code:
Sub testpastecode()
Dim iTemp As Long
Dim Fpath, CrName As String
Dim OutGo As Object
iTemp = Application.SheetsInNewWorkbook
Fpath = ThisWorkbook.Path
CrName = ThisWorkbook.Name
Application.SheetsInNewWorkbook = 1
Workbooks.Add
ActiveWorkbook.SaveAs Fpath & "\Report.xls"
Workbooks(CrName).ActiveSheet.Cells.Copy
With ActiveWorkbook
    .ActiveSheet.PasteSpecial
    .ActiveSheet.Name = Workbooks(CrName).ActiveSheet.Name
    .ActiveSheet.Range("A1").Select
    .Save
    .Close
End With
Application.SheetsInNewWorkbook = iTemp
Application.CutCopyMode = False
MsgBox "When Prompted please select - Allow"
Dim OutlookApp As Object
  Dim MItem As Object
  Dim Subj As String
  Dim EmailAddr As String
  Dim Recipient As String
  Dim Msg As String
  
  'Create Outlook object
  Set OutlookApp = CreateObject("Outlook.Application")
      'Get the data
      Subj = "Subject"
      Recipient = "Dave3009"
      EmailAddr = "Dave@3009"
            
     'Compose message
      Msg = "Hi Dave" & vbCrLf & vbCrLf
      Msg = Msg & "Here is my Report"
      Set MItem = OutlookApp.CreateItem(0)
      With MItem
        .To = EmailAddr
        .Subject = Subj
        .Body = Msg
        .attachments.Add (Fpath & "\Report.xls")
        .Send
   End With
    
End Sub
 

dave3009

Well-known Member
Joined
Jun 23, 2006
Messages
7,035
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
  2. Mobile
  3. Web
Cheers for the response

So as I'm using company equipment on which I have less privileges than I'd allow my own child, I suppose I should just tell the end users to expect it?

Here's how I cleaned up

Code:
Sub testpastecode()
Dim iTemp As Long
Dim Fpath, CrName, Msg, Subj As String
Dim OutlookApp, MItem As Object
Dim EmailAddr, Recipient As String

iTemp = Application.SheetsInNewWorkbook
Fpath = ThisWorkbook.Path
CrName = ThisWorkbook.Name

Application.SheetsInNewWorkbook = 1
Workbooks.Add
ActiveWorkbook.SaveAs Fpath & "\Report.xls"

Workbooks(CrName).ActiveSheet.Cells.Copy

With ActiveWorkbook
    .ActiveSheet.PasteSpecial
    .ActiveSheet.Name = Workbooks(CrName).ActiveSheet.Name
    .ActiveSheet.Range("A1").Select
    .Save
    .Close
End With
With Application
    .SheetsInNewWorkbook = iTemp
    .CutCopyMode = False
End With

MsgBox "When Prompted please select - Allow"

Set OutlookApp = CreateObject("Outlook.Application")

Subj = "Report"
EmailAddr = "dave@3009"
      
Msg = "Hi Dave" & vbCrLf & vbCrLf
Msg = Msg & "Here is my Report"
      
Set MItem = OutlookApp.CreateItem(0)

With MItem
    .To = EmailAddr
    .Subject = Subj
    .Body = Msg
    .attachments.Add (Fpath & "\Report.xls")
    .Send
End With
    
End Sub

Thanks again VoG II, I always appreciate your work
 
Last edited:
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,168,038
Messages
5,856,969
Members
431,843
Latest member
Malahhai

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top