Use macro to create outlook emails and attach files if there is any

[Koala123]

Hi guys, I am trying to use the below codes to create outlook emails but seems doesn't work.

The emails I want to create don't contain any attachment, but these codes I copied from somewhere else were seems designed for emails with attachments. So if I don't have any files to attach, how can I amend these codes to make them work?

Currently I will get "Type mismatch" error when run these codes, as the attachment cells are empty.

thanks heaps guys!

Dim Info_Arr As Variant


Sub Send_Email_Macro()


Dim n%
Info_Arr = Sheet1.UsedRange
n = UBound(Info_Arr)


For i = 2 To n
  Call Send_Email_By_Outlook(i)
Next i


End Sub


Sub Send_Email_By_Outlook(ByVal i As Integer)


Recipient = Info_Arr(i, 1)
Recipientcc = Info_Arr(i, 2)
Subj = Info_Arr(i, 3)
Body = Info_Arr(i, 4)
file = Info_Arr(i, 5)
If Len(Dir(file)) = 0 Then file = ""  [CODE]

------>error


Dim objOutlook As Outlook.Application
Dim objMail As MailItem


Set objOutlook = New Outlook.Application
Set objMail = objOutlook.CreateItem(olMailItem)


With objMail
.To = Recipient
.CC = Recipientcc
.Subject = Subj
.Body = Body
Dim files As Variant
files = Split(Info_Arr(i, 5), ",")
For Each file In files
.Attachments.Add file
Next
.Save
End With


Set objMail = Nothing
Set objOutlook = Nothing


End Sub
[/CODE]

 

[Logit]

.
If you won't be attaching files to your emails, you can delete these lines of code from the macro :

 Dim files As Variant    
    files = Split(Info_Arr(i, 5), ",")
    For Each file In files
  .Attachments.Add file  
    Next

 

[DanteAmor]

Let's remove the lines, try this:

Dim Info_Arr As Variant


Sub Send_Email_Macro()
    Dim n%
    Info_Arr = Sheet1.UsedRange
    n = UBound(Info_Arr)
    For i = 2 To n
      Call Send_Email_By_Outlook(i)
    Next i
End Sub


Sub Send_Email_By_Outlook(ByVal i As Integer)
    Recipient = Info_Arr(i, 1)
    Recipientcc = Info_Arr(i, 2)
    Subj = Info_Arr(i, 3)
    Body = Info_Arr(i, 4)
    
    Dim objOutlook As Outlook.Application
    Dim objMail As MailItem
    
    Set objOutlook = New Outlook.Application
    Set objMail = objOutlook.CreateItem(olMailItem)
    With objMail
      .To = Recipient
      .CC = Recipientcc
      .Subject = Subj
      .Body = Body
      .Save
    End With
    Set objMail = Nothing
    Set objOutlook = Nothing
End Sub

 

[Koala123]

Hi Dante thanks a lot, this works, at the time I am just wondering is it possible to fix that mismatch error? As in some occasions I may need to attach some files

 

[Logit]

.
Try this to replace the existing :

files = Split(Info_Arr(i, 5), ",")
    For Each file In files
		If file <> 0 then
  			.Attachments.Add file  
		End If
    Next

or

files = Split(Info_Arr(i, 5), ",")
    For Each file In files
		If file <> "" then
  			.Attachments.Add file  
		End If
    Next

 

[DanteAmor]

Try this:

Dim Info_Arr As Variant


Sub Send_Email_Macro()
    Dim n%
    Info_Arr = Sheet1.UsedRange
    n = UBound(Info_Arr)
    For i = 2 To n
      Call Send_Email_By_Outlook(i)
    Next i
End Sub


Sub Send_Email_By_Outlook(ByVal i As Integer)
    Recipient = Info_Arr(i, 1)
    Recipientcc = Info_Arr(i, 2)
    Subj = Info_Arr(i, 3)
    Body = Info_Arr(i, 4)
[COLOR=#0000ff]    file = Info_Arr(i, 5)[/COLOR]
    
    Dim objOutlook As Outlook.Application
    Dim objMail As MailItem
    
    Set objOutlook = New Outlook.Application
    Set objMail = objOutlook.CreateItem(olMailItem)
    With objMail
      .To = Recipient
      .CC = Recipientcc
      .Subject = Subj
      .Body = Body
[COLOR=#0000ff]      If file <> "" Then[/COLOR]
[COLOR=#0000ff]        Dim files As Variant, f As Variant[/COLOR]
[COLOR=#0000ff]        files = Split(Info_Arr(i, 5), ",")[/COLOR]
[COLOR=#0000ff]        For Each f In files[/COLOR]
[COLOR=#0000ff]            If Dir(f) <> "" Then[/COLOR]
[COLOR=#0000ff]                .Attachments.Add file[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
[COLOR=#0000ff]        Next[/COLOR]
[COLOR=#0000ff]      End If[/COLOR]
      .Save
    End With
    Set objMail = Nothing
    Set objOutlook = Nothing
End Sub