emailing from Activeworkbook

L

lionelnz

Well-known Member
Joined
Apr 6, 2006
Messages
571
I am trying to email the active workbook but my code does not open OL. I do not want send but proof read it first before sending. I have got this work before but as I am doing something different obviously I havenot got syntax right.

I copy a sheet into a new workbook, delete excess sheets, rename the workbook, with newworkbook open I am trying to email it as an attachment. any here it isThis does not have to be as it is okay to close the new wbk & then email it as an attachment. Anyway here is my code -

Code: 
Sub CopyAsht2NwWbk()
'Copies active sheet into new workbook,
'deletes the empty sheets &
'renames the new workbook &
'emails the new workbook

    'Hwb is source/active wbk and Nwb is new wbk
    Dim Hwb, Nwb As Workbook
    'Hws is source/active ws and Nws is new ws
    Dim Hws, Nws As Worksheet
    'Gives filename and keeps new file in current directory
    Dim FN, Nm, Dt, myPath As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    
    Set Hwb = ActiveWorkbook
    Set Hws = ActiveSheet
    
    Application.ScreenUpdating = False
     ' Set variable to path of active workbook
    myPath = ActiveWorkbook.Path
    Set Nwb = Workbooks.Add
    Hws.Copy Before:=Sheets(1)
    
    Nm = Range("D7").Value & " WE "

'Date format for filename
  Dt = Format(Range("C25").Value, "DDMMYYYY")
'Workbook name
  FN = "Timesheet " & Nm & Dt
Application.DisplayAlerts = False
        'Delete excess sheets
        For Each Nws In Sheets
            If Left(Nws.Name, 2) = "Sh" Then Nws.Delete
        Next Nws
Application.DisplayAlerts = True

ActiveWorkbook.SaveAs (myPath & "/" & FN)

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

    'On Error Resume Next
    With OutMail
        .To = "emailaddress" 'actual address
        .CC = ""
        .BCC = ""
        .Subject = "TimeSheet"
        .Body = "Hi there"
        .Attachments.Add (myPath & "/" & FN)
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        '.Send   'or use .Display
    End With
    'On Error GoTo 0

    'wb2.Close SaveChanges:=False

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Nwb.Close
    Hwb.Activate
End Sub
TIA

Lionel Downunder
Office2003 with XP Prof
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
Thanks Andrew. Yes I did notice I was opening OL twice. I have tried to set OL to Visible with this code
Set OutApp = New Outlook.Application
OutApp.Application.Visible = True
Set OutMail = OutApp.CreateItem(olMailItem)
But still getting an error.

BTW I am using early binding by referencing OL Lib in VBA Ed Tools/Reference.
 
Upvote 0
try.
Also, have a look at RonDeBruins site for sending e_mails from EXcel
www.rondebruin.nl
Rich (BB code): 
Sub CopyAsht2NwWbk()
'Copies active sheet into new workbook,
'deletes the empty sheets &
'renames the new workbook &
'emails the new workbook

    'Hwb is source/active wbk and Nwb is new wbk
    Dim Hwb, Nwb As Workbook
    'Hws is source/active ws and Nws is new ws
    Dim Hws, Nws As Worksheet
    'Gives filename and keeps new file in current directory
    Dim FN, Nm, Dt, myPath As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    
    Set Hwb = ActiveWorkbook
    Set Hws = ActiveSheet
    
    Application.ScreenUpdating = False
     ' Set variable to path of active workbook
    myPath = ActiveWorkbook.Path
    Set Nwb = Workbooks.Add
    Hws.Copy Before:=Sheets(1)
    
    Nm = Range("D7").Value & " WE "

'Date format for filename
  Dt = Format(Range("C25").Value, "DDMMYYYY")
'Workbook name
   Hws.Name = "Timesheet " & Nm & Dt

Application.DisplayAlerts = False
        'Delete excess sheets
        For Each Nws In Sheets
            If Left(Nws.Name, 2) = "Sh" Then Nws.Delete
        Next Nws
Application.DisplayAlerts = True

ActiveWorkbook.SaveAs (myPath & "/" & FN), FileFormat:=FileFormatNum = 52 'or 56 for excel 2007-2010
    'On Error Resume Next
    With OutMail
        .To = "emailaddress" 'actual address
        .CC = ""
        .BCC = ""
        .Subject = "TimeSheet"
        .Body = "Hi there"
        .Attachments.Add (myPath & "/" & FN)
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Display
    End With
    'On Error GoTo 0

    'wb2.Close SaveChanges:=False

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Nwb.Close
    Hwb.Activate
End Sub
 
Upvote 0
Thanks Michael. Saving the file is not the problem. Getting OL to open & attach the file is the problem. I have read numerous ontributions made by Ron & I have Walkenbach's VBA Bible for 2003. I have VBA for emailing multiple recipients from SS but saving as a draft 1st but I cannot seem to get this code working i.e open OL, attach the file & save it as a draft.
Here is my adjusted code
Code: 
Sub CopyAsht2NwWbk()
'Copies active sheet into new workbook,
'deletes the empty sheets &
'renames the new workbook &
'emails the new workbook & uses early binding.

    'Hwb is source/active wbk and Nwb is new wbk
    Dim Hwb, Nwb As Workbook
    'Hws is source/active ws and Nws is new ws
    Dim Hws, Nws As Worksheet
    'Gives filename and keeps new file in current directory
    Dim FN, Nm, Dt, myPath As String
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
   
    'Set OutApp = CreateObject("Outlook.Application")
    'Set OutMail = OutApp.CreateItem(olMailItem)
    
    Set Hwb = ActiveWorkbook
    Set Hws = ActiveSheet
    
    'Application.ScreenUpdating = False
     ' Set variable to path of active workbook
    myPath = ActiveWorkbook.Path
    Set Nwb = Workbooks.Add
    Hws.Copy Before:=Sheets(1)
    
    Nm = Range("D7").Value & " WE "

'Date format for filename
  Dt = Format(Range("C25").Value, "DDMMYYYY")
'Workbook name
  FN = "Timesheet " & Nm & Dt
Application.DisplayAlerts = False
        'Delete excess sheets
        For Each Nws In Sheets
            If Left(Nws.Name, 2) = "Sh" Then Nws.Delete
        Next Nws
Application.DisplayAlerts = True

ActiveWorkbook.SaveAs (myPath & "/" & FN)

 'Opens OL & sets OL visible
 Set OutApp = New Outlook.Application
 OutApp.Application.Visible = True
 Set OutMail = OutApp.CreateItem(olMailItem)

    'On Error Resume Next
    With OutMail
        .To = "Des.McCleary@EnviroWaste.co.nz"
        .CC = ""
        .BCC = ""
        .Subject = "TimeSheet"
        .Body = "Hi there"
        .Attachments.Add FN
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        '.Send   'or use .Display
    End With
    'On Error GoTo 0

    'wb2.Close SaveChanges:=False

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Nwb.Close
    Hwb.Activate
End Sub

Thanks
 
Upvote 0
Are you using Outlook or Outlook Express ?
 
Upvote 0
I also noticed that you have both .send AND .display commented out.

Without one or the other Outlook won't fire !!
 
Upvote 0
Further points to note
Change these 2 lines
Rich (BB code): 
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem

TO

    Dim OutApp As object
    Dim OutMail As object

then change these 2 lines
Rich (BB code): 
 Set OutApp = New Outlook.Application
 OutApp.Application.Visible = True  delete this line
 Set OutMail = OutApp.CreateItem(olMailItem)

TO

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
Upvote 0
Thanks Michael for your help. I have finally got it to work. :biggrin:

Here is my code. I was trying to use early binding by reference OL lib in the VBA editor. This meansd ifferent syntax if it works. However I have got it to work finally. Please not the syntax of the filename in the ".Attachment" of the email code.
Code: 
Sub CopyAsht2NwWbk()
'Copies active sheet into new workbook,
'deletes the empty sheets &
'renames the new workbook &
'emails the new workbook

    'Hwb is source/active wbk and Nwb is new wbk
    Dim Hwb, Nwb As Workbook
    'Hws is source/active ws and Nws is new ws
    Dim Hws, Nws As Worksheet
    'Gives filename and keeps new file in current directory
    Dim FN, Nm, Dt, myPath As String
    
    Dim OutApp As Object
    Dim OutMail As Object
           
    Set Hwb = ActiveWorkbook
    Set Hws = ActiveSheet
    
    'Application.ScreenUpdating = False
     ' Set variable to path of active workbook
    myPath = ActiveWorkbook.Path
    Set Nwb = Workbooks.Add
    Hws.Copy Before:=Sheets(1)
    
    Nm = Range("D7").Value & " WE "

'Date format for filename
  Dt = Format(Range("C25").Value, "DDMMYYYY")
'Workbook name
  FN = "Timesheet " & Nm & Dt
Application.DisplayAlerts = False
        'Deletes excess sheets
        For Each Nws In Sheets
            If Left(Nws.Name, 2) = "Sh" Then Nws.Delete
        Next Nws
Application.DisplayAlerts = True

ActiveWorkbook.SaveAs (myPath & "/" & FN)

 'Opens OL & sets OL visible
 'Set OutApp = New Outlook.Application
 'OutApp.Application.Visible = True
 'Set OutMail = OutApp.CreateItem(olMailItem)
 Set OutApp = CreateObject("Outlook.Application")
 Set OutMail = OutApp.CreateItem(olMailItem)

    'On Error Resume Next
    With OutMail
        .To = "email@xxxx.com"
        .CC = ""
        .BCC = ""
        .Subject = "TimeSheet"
        .Body = "Hi there"
        .Attachments.Add (myPath & "/" & FN & ".xls")
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Display 'or use .Send
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Nwb.Close
    Hwb.Activate
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Emailing active WS as Excel attachment failing
Replies
5
Views
277
NoSparks
N
M
  • Question
Workbook in attachement of Email - specific Xls format . How to ?
Replies
1
Views
302
Fluff
Fluff
melodramatic
  • Question
VBA Send Outlook email, Save email to file folder
Replies
3
Views
505
melodramatic
melodramatic
StephenC101
  • Question
Mac Excel macro help needed please
Replies
1
Views
310
jkpieterse
jkpieterse
G
  • Solved
Dynamic Button for Email Macro
Replies
4
Views
233
GarnesGambit
G

Forum statistics

Threads
1,215,294
Messages
6,124,100
Members
449,142
Latest member
championbowler

Share this page

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
Back
Top