Results 1 to 3 of 3
  1. #1
    New Lounger
    Join Date
    May 2015
    Posts
    13
    Thanks
    5
    Thanked 0 Times in 0 Posts

    Type mismatch error with code to send Excel sheet via Outlook

    Hi experts,
    I have been trying to work this code below for the purpose explained in the topic,
    I get a type mismatch error on the Set olMail = olApp.CreateItem(olMailItem) line, in red fonts below. I'm quite new to these kind of codes and having a hard time understanding it. Can anyone please help me solve and complete this operation with the code?

    Option Explicit


    Sub ExportEmail()


    Dim objfile As FileSystemObject
    Dim xNewFolder
    Dim xDir As String, xMonth As String, xFile As String, xPath As String
    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim NameX As Name, xStp As Long
    Dim xDate As Date, AWBookPath As String
    Dim currentWB As Workbook, newWB As Workbook
    Dim strEmailTo As String, strEmailCC As String, strEmailBCC As String, strDistroList As String

    AWBookPath = ActiveWorkbook.Path & "\"

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = "Creating Email and Attachment for " & Format(Date, "dddd dd mmmm yyyy")

    Set currentWB = ActiveWorkbook

    xDate = Date

    '******************************Grabbing New WorkBook and Formatting*************

    Sheets(Array("Cover", "Interval Data", "rawData")).Copy

    Set newWB = ActiveWorkbook

    Range("A1").Select
    Sheets("rawData").Visible = False
    Sheets("Cover").Select


    '******************************Creating Pathways*********************************

    xDir = AWBookPath
    xMonth = Format(xDate, "mm mmmm yy") & "\"

    xFile = "Customer Service Dashboard Report " & Format(xDate, "dd-mm-yyyy") & ".xlsx"

    xPath = xDir & xMonth & xFile

    '******************************Saving File in Pathway*********************************

    Set objfile = New FileSystemObject

    If objfile.FolderExists(xDir & xMonth) Then
    If objfile.FileExists(xPath) Then
    objfile.DeleteFile (xPath)
    newWB.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
    , CreateBackup:=False

    Application.ActiveWorkbook.Close
    Else
    newWB.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
    , CreateBackup:=False
    Application.ActiveWorkbook.Close
    End If
    Else
    xNewFolder = xDir & xMonth
    MkDir xNewFolder
    newWB.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
    , CreateBackup:=False
    Application.ActiveWorkbook.Close
    End If

    '******************************Preparing Distribution List *********************************


    currentWB.Activate
    Sheets("Email").Visible = True
    Sheets("Email").Select

    strEmailTo = ""
    strEmailCC = ""
    strEmailBCC = ""

    xStp = 1

    Do Until xStp = 4

    Cells(2, xStp).Select

    Do Until ActiveCell = ""

    strDistroList = ActiveCell.Value

    If xStp = 1 Then strEmailTo = strEmailTo & strDistroList & "; "
    If xStp = 2 Then strEmailCC = strEmailCC & strDistroList & "; "
    If xStp = 3 Then strEmailBCC = strEmailBCC & strDistroList & "; "

    ActiveCell.Offset(1, 0).Select

    Loop

    xStp = xStp + 1

    Loop

    Range("A1").Select

    '******************************Preparing Email*********************************

    Set olApp = New Outlook.Application
    Dim olNs As Outlook.Namespace
    Set olNs = olApp.GetNamespace("MAPI")
    olNs.Logon
    Set olMail = olApp.CreateItem(olMailItem)
    olMail.To = strEmailTo
    olMail.CC = strEmailCC
    olMail.BCC = strEmailBCC


    olMail.Subject = Mid(xFile, 1, Len(xFile) - 4)
    olMail.Body = vbCrLf & "Hello Everyone," _
    & vbCrLf & vbCrLf & "Please find attached the " & Mid(xFile, 1, Len(xFile) - 4) & "." _
    & vbCrLf & vbCrLf & "Regards," _
    & vbCrLf & "Chandoo.Org"


    olMail.Attachments.Add xPath
    olMail.Display

    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    End Sub


    Sub SaveClose()
    ActiveWorkbook.Close True
    End Sub

  2. #2
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,172
    Thanks
    47
    Thanked 981 Times in 911 Posts
    You haven't defined olMailItem anywhere.

    cheers, Paul

  3. #3
    3 Star Lounger
    Join Date
    Apr 2001
    Location
    Levin, Manawatu-Wanganui, New Zealand
    Posts
    324
    Thanks
    9
    Thanked 28 Times in 26 Posts
    Hi
    I sometimes find it easier to get things working chunk by chunk.
    Try this after changing tweetyBird's email address.
    Code:
    Sub sendEmail()
    'skeleton test script from Excel vba
    Dim oApp As Object
    Dim oMail As Object
    
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(olMailItem)
    'Set oMail = oApp.CreateItem(0)
        With oMail
            .to = "tweetyBird@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there from Daffy Duck"
            .Send   'or use .Display
            '.display
        End With
    End Sub
    Hope it helps
    Geof

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •