emailing from Activeworkbook

[lionelnz]

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 -

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

 

[Michael M]

Excellent, glad you got it sorted.
thanks for the feedback.