Outlook and Excel

dave3009

Well-known Member
Joined
Jun 23, 2006
Messages
7,002
Office Version
  1. 365
  2. 2016
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
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

dave3009

Well-known Member
Joined
Jun 23, 2006
Messages
7,002
Office Version
  1. 365
  2. 2016
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,002
Office Version
  1. 365
  2. 2016
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:

Watch MrExcel Video

Forum statistics

Threads
1,122,822
Messages
5,598,304
Members
414,224
Latest member
Crazy_FC

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