Email workbook using Outlook

[Trevor3007]

hi,

Doe anyone have the solution to my issue?

I would like to email the applicable workbook to out look. It will always be ( for the foreseeable future ATM) to the same recipients.

1 x to

2 x CC

however, I need the subject line to contain the WC (IE 03/09/18) which will change weekly & always the 1st Monday of the applicable week.

And the body of the email would say "This is 1 of 5" or 2 of 5 etc ( this would depend of it was a 4/5 week) . It would also display the 1st Friday of the next month (IE 7/9/18)

I don know if it would design something in Excel to then transpose in outlook.... Anyhoo , I do hope some canny & knowledgeable person is up the challenge & can sort this for me?

KR
Trevor3007

 

[Trevor3007]

.
This is a direct way of opening Outlook, using the full path to the program.

If you are unable to open Outlook using this macro, there is something wrong with your computer ... or O/S ... or Outlook is not installed on your compter:

Option Explicit


Sub OutLookOpen()
    Dim x As Variant
    Dim Path As String


    ' Set the Path variable equal to the path of your program's installation
    Path = "C:\Program Files (x86)\Microsoft Office\Office12\Outlook.exe" [COLOR=#ff0000][B]'<---- change the path in this line to match the location of Outlook on your computer[/B][/COLOR]


    x = Shell(Path, vbNormalFocus)
End Sub

good morning logit,

thanks for your help with my issue.

changed as you advised & outlook opens. I only ran the your code above .


Path is C:\Program Files (x86)\Microsoft Office\root\Office16\outlook.exe

MTA
Trevor3007

 

[Logit]

.

 

[Trevor3007]

hi logit,

where would I add Path is C:\Program Files (x86)\Microsoft Office\root\Office16\outlook.exe into ;-

[/COLOR]Option Explicit
 
Sub PC_Email()
   
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim MailAttachments As String
    Dim cell As Variant '                             Not previously DIM'd
   
    Sheets("Sheet1").Select '                         Edit as required
    Range("A1").Select
   
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
   
 
   On Error GoTo cleanup
    If WorksheetFunction.CountA(Range("K2:K100")) = 0 Then
        MsgBox "To send email, please enter an X in Column K.", vbCritical, "Missing Entry"
        Exit Sub
    End If
    For Each cell In Columns("C").Cells
        If cell.Value Like "?*@?*.?*" And _
        LCase(Cells(cell.Row, "K").Value) <> "" Then
   
    Set OutMail = OutApp.CreateItem(0)
       
            On Error Resume Next
                             
            With OutMail
           
              strbody = "Please Delete Any Previous Emails Related To This Period" & vbNewLine & vbNewLine & _
                        "Number " & Cells(cell.Row, "F") & " timesheets covering the period WC " & Cells(cell.Row, "A") & " To be paid " & Cells(cell.Row, "G") & " ." & vbNewLine & vbNewLine & _
                        "Good Morning, " & vbNewLine & vbNewLine & _
                        "Please find attached applicable time sheet / expense's / receipts for WC: " & Cells(cell.Row, "A") & vbNewLine & vbNewLine & _
                        "Number : " & Cells(cell.Row, "F") & " timesheets to be paid " & Cells(cell.Row, "G") + vbNewLine & vbNewLine & _
                        "KR" & vbNewLine & vbNewLine & _
                        "TMcL" & vbNewLine & vbNewLine & _
             “07902 007 007”
                .To = Cells(cell.Row, "C").Value
                .CC = Cells(cell.Row, "D").Valu
                .BCC = Cells(cell.Row, "E").Value
                .Subject = "WC " & Cells(cell.Row, "A").Value
                .Body = strbody
              
                '.Attachments.Add Application.ActiveWorkbook.FullName
                .Attachments.Add ActiveSheet.Cells(cell.Row, "H").Value
                .Attachments.Add ActiveSheet.Cells(cell.Row, "I").Value
                .Attachments.Add ActiveSheet.Cells(cell.Row, "J").Value
                .Attachments.Add ActiveSheet.Cells(cell.Row, "L").Value
                .Attachments.Add ActiveSheet.Cells(cell.Row, "M").Value
               
                .Display  'Or use .Send
                 
               
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell
 
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
   
End Sub

[COLOR=#333333]

 

[Trevor3007]

Perhaps you could find what you need on this website...

https://www.rondebruin.nl/win/s1/outlook/mail.htm

hi logit,

sorry for not appearing to get back to you...i think i replied to my my own message...haha

anyhoos ggod news???...

seems like your VB & outlook are now a marriage in heaven....


many thanks again for your hard work & assistance you have given me.

Kindest regards
Trevor3007