Code Correction required

R

Rohith1324

Board Regular
Joined
Feb 27, 2018
Messages
114
Hi,

I have the below code where the Mail is triggered even when the attachment ( File ) is not available in the specified path.

Can someone suggest how can the code ensure the mail is triggered only if the file/files are available in specified path.

If the value in If c.Offset(0, 9).Value = "SW" Then it should check the file from path - picName = c.Offset(0, 2).Value only if the file exists in the path it should trigger the mail with the attachment.

Else

it should check the files in both the path - "picName = c.Offset(0, 2).Value" & Zipname = c.Offset(0, 3).Value only if the both the files are existing then it should trigger the mail - even single file at one location is not available then it should not trigger the mail.

The code i'm using is as follow :

Dim picName As String
Dim Zipname As String
Dim c As Range
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim i As Integer
On Error Resume Next

For Each c In Range("A2:A" & Cells(Rows.Count, "G").End(xlUp).Row).Cells
picName = c.Offset(0, 2).Value
Zipname = c.Offset(0, 3).Value
Debug.Print picName
Debug.Print Zipname
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
.To = c.Offset(0, 4).Value
.CC = c.Offset(0, 5).Value
.Subject = c.Offset(0, 1).Value
.Attachments.Add picName
.Attachments.Add Zipname
.HTMLBody = .HTMLBody & "<b><font size='03' color='black'>Hi</font></b>"
If c.Offset(0, 9).Value = "SW" Then
.HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#39036F>validation required </b></font>"
Else
.HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#FF00FF><span style=background-color:'yellow'>Validation complete</b></span></font>"
End If
.HTMLBody = .HTMLBody & "<br><br>Regards"
.HTMLBody = .HTMLBody & "<br>Rohith M"
'.Display
.Send
End With
If OutLookMailItem.Send Then
c.Offset(0, 10).Value = "success"
Else
c.Offset(0, 10).Value = "failed"
End If
Next c
End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
Try this:

VBA Code: 
Sub SendMail()
  Dim picName As String, Zipname As String
  Dim c As Range
  Dim OutLookApp As Object, OutLookMailItem As Object
  Dim i As Integer, cont As Integer
  On Error Resume Next
  
  For Each c In Range("A2:A" & Cells(Rows.Count, "G").End(xlUp).Row).Cells
    cont = 0
    picName = c.Offset(0, 2).Value
    Zipname = c.Offset(0, 3).Value
    If c.Offset(0, 9).Value = "SW" Then
      If Dir(picName) <> "" Then
        cont = 1
      End If
    Else
      If Dir(picName) <> "" And Dir(Zipname) <> "" Then
        cont = 2
      End If
    End If
    If cont > 0 Then
      'Debug.Print picName
      'Debug.Print Zipname
      Set OutLookApp = CreateObject("Outlook.application")
      Set OutLookMailItem = OutLookApp.CreateItem(0)
      With OutLookMailItem
        .To = c.Offset(0, 4).Value
        .CC = c.Offset(0, 5).Value
        .Subject = c.Offset(0, 1).Value
        If cont > 0 Then .Attachments.Add picName
        If cont = 2 Then .Attachments.Add Zipname
        .HTMLBody = .HTMLBody & "<b><font size='03' color='black'>Hi</font></b>"
        If c.Offset(0, 9).Value = "SW" Then
          .HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#39036F>validation required </b></font>"
        Else
          .HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#FF00FF><span style=background-color:'yellow'>Validation complete</b></span></font>"
        End If
        .HTMLBody = .HTMLBody & "<br><br>Regards"
        .HTMLBody = .HTMLBody & "<br>Rohith M"
        .Display
        '.Send
      End With
      If OutLookMailItem.Send Then
        c.Offset(0, 10).Value = "success"
      Else
        c.Offset(0, 10).Value = "failed"
      End If
    End If
  Next c
End Sub
 
Upvote 0
DanteAmor said:
Try this:

VBA Code: 
Sub SendMail()
  Dim picName As String, Zipname As String
  Dim c As Range
  Dim OutLookApp As Object, OutLookMailItem As Object
  Dim i As Integer, cont As Integer
  On Error Resume Next
 
  For Each c In Range("A2:A" & Cells(Rows.Count, "G").End(xlUp).Row).Cells
    cont = 0
    picName = c.Offset(0, 2).Value
    Zipname = c.Offset(0, 3).Value
    If c.Offset(0, 9).Value = "SW" Then
      If Dir(picName) <> "" Then
        cont = 1
      End If
    Else
      If Dir(picName) <> "" And Dir(Zipname) <> "" Then
        cont = 2
      End If
    End If
    If cont > 0 Then
      'Debug.Print picName
      'Debug.Print Zipname
      Set OutLookApp = CreateObject("Outlook.application")
      Set OutLookMailItem = OutLookApp.CreateItem(0)
      With OutLookMailItem
        .To = c.Offset(0, 4).Value
        .CC = c.Offset(0, 5).Value
        .Subject = c.Offset(0, 1).Value
        If cont > 0 Then .Attachments.Add picName
        If cont = 2 Then .Attachments.Add Zipname
        .HTMLBody = .HTMLBody & "<b><font size='03' color='black'>Hi</font></b>"
        If c.Offset(0, 9).Value = "SW" Then
          .HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#39036F>validation required </b></font>"
        Else
          .HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#FF00FF><span style=background-color:'yellow'>Validation complete</b></span></font>"
        End If
        .HTMLBody = .HTMLBody & "<br><br>Regards"
        .HTMLBody = .HTMLBody & "<br>Rohith M"
        .Display
        '.Send
      End With
      If OutLookMailItem.Send Then
        c.Offset(0, 10).Value = "success"
      Else
        c.Offset(0, 10).Value = "failed"
      End If
    End If
  Next c
End Sub
Click to expand...
Its working but for the line where the mail is not sent ( missing files )...it is not showing the status as "Failed "...it is blank and where it has triggered the mails it is showing the status as "Success"....can we do something here
 
Upvote 0
Try this:

VBA Code: 
Sub SendMail()
  Dim picName As String, Zipname As String, c As Range
  Dim OutLookApp As Object, OutLookMailItem As Object, i As Integer, cont As Integer
  On Error Resume Next
  
  For Each c In Range("A2:A" & Cells(Rows.Count, "G").End(xlUp).Row).Cells
    cont = 0
    picName = c.Offset(0, 2).Value
    Zipname = c.Offset(0, 3).Value
    If c.Offset(0, 9).Value = "SW" Then
      If Dir(picName) <> "" Then
        cont = 1
      End If
    Else
      If Dir(picName) <> "" And Dir(Zipname) <> "" Then
        cont = 2
      End If
    End If
    If cont > 0 Then
      Set OutLookApp = CreateObject("Outlook.application")
      Set OutLookMailItem = OutLookApp.CreateItem(0)
      With OutLookMailItem
        .To = c.Offset(0, 4).Value
        .CC = c.Offset(0, 5).Value
        .Subject = c.Offset(0, 1).Value
        If cont > 0 Then .Attachments.Add picName
        If cont = 2 Then .Attachments.Add Zipname
        .HTMLBody = .HTMLBody & "<b><font size='03' color='black'>Hi</font></b>"
        If c.Offset(0, 9).Value = "SW" Then
          .HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#39036F>validation required </b></font>"
        Else
          .HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#FF00FF><span style=background-color:'yellow'>Validation complete</b></span></font>"
        End If
        .HTMLBody = .HTMLBody & "<br><br>Regards"
        .HTMLBody = .HTMLBody & "<br>Rohith M"
        .Display
        '.Send
      End With
      If OutLookMailItem.Send Then
        c.Offset(0, 10).Value = "success"
      Else
        c.Offset(0, 10).Value = "failed"
      End If
    Else
      c.Offset(0, 10).Value = "missing files"
    End If
  Next c
End Sub
 
Upvote 0
DanteAmor said:
Try this:

VBA Code: 
Sub SendMail()
  Dim picName As String, Zipname As String, c As Range
  Dim OutLookApp As Object, OutLookMailItem As Object, i As Integer, cont As Integer
  On Error Resume Next
 
  For Each c In Range("A2:A" & Cells(Rows.Count, "G").End(xlUp).Row).Cells
    cont = 0
    picName = c.Offset(0, 2).Value
    Zipname = c.Offset(0, 3).Value
    If c.Offset(0, 9).Value = "SW" Then
      If Dir(picName) <> "" Then
        cont = 1
      End If
    Else
      If Dir(picName) <> "" And Dir(Zipname) <> "" Then
        cont = 2
      End If
    End If
    If cont > 0 Then
      Set OutLookApp = CreateObject("Outlook.application")
      Set OutLookMailItem = OutLookApp.CreateItem(0)
      With OutLookMailItem
        .To = c.Offset(0, 4).Value
        .CC = c.Offset(0, 5).Value
        .Subject = c.Offset(0, 1).Value
        If cont > 0 Then .Attachments.Add picName
        If cont = 2 Then .Attachments.Add Zipname
        .HTMLBody = .HTMLBody & "<b><font size='03' color='black'>Hi</font></b>"
        If c.Offset(0, 9).Value = "SW" Then
          .HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#39036F>validation required </b></font>"
        Else
          .HTMLBody = .HTMLBody & "<br><br><b><font size='05' color=#FF00FF><span style=background-color:'yellow'>Validation complete</b></span></font>"
        End If
        .HTMLBody = .HTMLBody & "<br><br>Regards"
        .HTMLBody = .HTMLBody & "<br>Rohith M"
        .Display
        '.Send
      End With
      If OutLookMailItem.Send Then
        c.Offset(0, 10).Value = "success"
      Else
        c.Offset(0, 10).Value = "failed"
      End If
    Else
      c.Offset(0, 10).Value = "missing files"
    End If
  Next c
End Sub
Click to expand...
It's working now...thank you...
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
Trying to improve quality of image on Email.
Replies
0
Views
43
Eric Penfold
E
G
  • Question
Excel VBA to reply to existing email chain and add workbook as attachment
Replies
4
Views
193
gopalgriffith
G
C
  • Solved
VBA attach PDF to email stopped working
Replies
8
Views
661
FormR
FormR
G
  • Solved
Dynamic Button for Email Macro
Replies
4
Views
204
GarnesGambit
G
J
  • Solved
Email body not showing using html.
Replies
3
Views
590
Logit
Logit

Forum statistics

Threads
1,214,653
Messages
6,120,749
Members
448,989
Latest member
mariah3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top