Sending Emails with Image signature in Outlook

Dim outlukApp As Outlook.Application, outlukMailItm As Outlook.MailItem, emailid, myval, i As Integer, fullbody As String
Dim sigstring As String, signature As String
Sub sendMail()
    Set outlukApp = New Outlook.Application
    Set outlukMailItm = outlukApp.CreateItem(olMailItem)
    myval = Application.InputBox("Enter Mutiple  EmailId with ; delimiter", "EmailId")
    On Error Resume Next
    If myval = False Then
        Exit Sub
    Else
         emailid = Split(myval, ";")
        
       
         For i = 0 To UBound(emailid)
          fullbody = "Dear," & "<br>"
          fullbody = fullbody & "<p>Please find the attachment of new joinee details</p><br><br>"
          fullbody = fullbody & "<br> Best Regards,"
             With outlukMailItm
                     .Display
                     .To = emailid(i)
                    
                     .Subject = "New Joinee Details"
                     .HTMLBody = "Dear,<br>" & "<p>Please find the attachment of new joinee details</p><br><br><br> Best Regards," & .HTMLBody
                     .Attachments.Add (ThisWorkbook.Path & "\" & ThisWorkbook.Name)
                     .Display
                     Application.DisplayAlerts = False
                     .Send
             End With
            
            
         Next
     End If
    Set outlukMailItm = Nothing
    Set outlukApp = Nothing
   
End Sub

Split File and send e-mail with Attachment

Task : split an excel file into separate files using particular customer
codes and then email these directly to a particular email account depending
on the  customer code(column A).



Option Explicit
Dim mycoll As Collection, rowcount As Long, myrng As Range, cell As Object, j As Long
Dim destinationwb As Workbook, outApp As Outlook.Application, outMail, newwb As Workbook

Sub createFiles()
Set mycoll = New Collection
On Error Resume Next
rowcount = ThisWorkbook.Sheets(1).Range("A3").End(xlDown).Row

Set myrng = ThisWorkbook.Sheets(1).Range("A3:A" & rowcount)
    For Each cell In myrng
        mycoll.Add cell, CStr(cell)


    Next
    For j = 1 To mycoll.Count
    Set outApp = New Outlook.Application
    Set outMail = outApp.CreateItem(olMailItem)
    Set destinationwb = Workbooks.Add
    destinationwb.SaveAs Filename:=ThisWorkbook.Path & "\" & mycoll(j), FileFormat:=56
        ThisWorkbook.Sheets(1).Range("A2").AutoFilter field:=1, Criteria1:=mycoll(j)
        ThisWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=destinationwb.Sheets(1).Range("A1")
         Set newwb = ActiveWorkbook
     
     
        destinationwb.Save
        With outMail
            .To = mycoll(j) & "@yahoo.com"
            .Subject = "Monthly Account Summary"
         
            .Body = "Hi," & vbNewLine & "     Please find the attachment" & vbNewLine & "Regards," & vbNewLine & "Soumyendu"
         
            .Attachments.Add (ThisWorkbook.Path & "\" & newwb.Name)
            .Display
         
        End With
        Application.DisplayAlerts = False
        destinationwb.Close

         Application.DisplayAlerts = False
         Application.Wait (Now + TimeValue("0:00:02"))
         Application.SendKeys "%s" '
        Set outMail = Nothing
     
        Set outApp = Nothing
     
    Next
End Sub

https://drive.google.com/file/d/0B23eJ2xd9ODyb2VmRm1vblJjWGM/edit?usp=sharing

Sending Attachment through OutLook

Sub sendMail
Dim outApp As New Outlook.Application, outMail As Variant,mailId as String
Set outMail = outApp.CreateItem(olMailItem)
        With outMail
            .To = mailId
            .Subject = Mid(wb.Name, 1, InStr(wb.Name, ".") - 1)
            .Body = "Hi," & vbNewLine & "     Please find the attachment" & vbNewLine & "Regards," &        vbNewLine & "Soumyendu"
            .Attachments.Add (wb.Path & "\" & wb.Name)
         
            .Display
        End With
    wb.Close


End sub