Excel VB Attachment available or not and Email sending Log

[nrk]

i want to create msg box if attachment not available and don't send that mail proceed to next mail after that same workbook write log whom to send subject and date .

im very new to VBA pls help

Sub Mail()


On Error Resume Next


Dim o As Object




Set o = CreateObject("Outlook.Application")




Dim omail As Object


Set omail = CreateObject("Outlook.MailItem")


Dim i As Long
For i = 2 To Range("a3000").End(xlUp).Row
Set omail = o.CreateItem(olMailItem)
With omail

Dim mysig As String


mysig =
Dim mysig1 As String
mysig1 =


.body = "
.to = Cells(i, 17).Value
.Subject = " -" & Cells(i, 1).Value
.Attachments.Add Cells(i, 30).Value
omail.SentOnBehalfOfName = ""

.send







End With


Next




End Sub

[nrk]

ls help

[nrk]

Help

[nrk]

could you help anyone i trust this form :crying:

[gmayor]

Please be patient - if the answers are known someone will get back to you. In this case me :hi:
The following should work for you. It will create a message log in the same workbook.
I would suggest that you either comment out the .Send line, or ensure that Outlook does not send immediately, while testing, so that you don't send out unwanted messages.


Option Explicit

Sub Mail()
'Graham Mayor - http://www.gmayor.com - Last updated - 01 Oct 2018
'This macro requires the code from
'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to open Outlook

Dim olApp As Object
Dim olMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim FSO As Object
Dim xlSheet As Worksheet
Dim xlLog As Worksheet
Dim bSheet As Boolean
Dim i As Long
Dim NextRow As Long
Dim LastRow As Long

On Error GoTo err_Handler
Set olApp = OutlookApp() 'Use the function from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to open Outlook, or it will not work correctly

Set FSO = CreateObject("Scripting.FileSystemObject")
Set xlSheet = ActiveSheet
LastRow = xlSheet.Cells(xlSheet.Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRow
If FSO.FileExists(xlSheet.Cells(i, 30)) Then
Set olMail = olApp.CreateItem(0)
With olMail
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor 'access the message body for editing
Set oRng = wdDoc.Range
oRng.Collapse 1
oRng.Text = "Please find attached file - " & xlSheet.Cells(i, 30).value
.To = xlSheet.Cells(i, 17).value
.Subject = " -" & xlSheet.Cells(i, 1).value
.Attachments.Add xlSheet.Cells(i, 30).value
.Display 'do not delete
'olMail.SentOnBehalfOfName = ""
.Send
End With
Else
For Each xlLog In Sheets
If xlLog.Name = "Unsent Message Log" Then
bSheet = True
Exit For
End If
Next xlLog
If Not bSheet = True Then
Set xlLog = Sheets.Add
xlLog.Name = "Unsent Message Log"
xlLog.Range("A1") = "Date"
xlLog.Range("B1") = "To"
xlLog.Range("C1") = "Subject"
xlLog.Range("D1") = "Attachment"
End If
NextRow = xlLog.Cells(xlLog.Rows.Count, "A").End(xlUp).Row + 1
xlLog.Cells(NextRow, 1) = Date
xlLog.Cells(NextRow, 2) = xlSheet.Cells(i, 17)
xlLog.Cells(NextRow, 3) = xlSheet.Cells(i, 1)
xlLog.Cells(NextRow, 4) = xlSheet.Cells(i, 30)
End If
DoEvents
Next i
lbl_Exit:
Set xlSheet = Nothing
Set xlLog = Nothing
Set FSO = Nothing
Set olApp = Nothing
Set olMail = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
err_Handler:
MsgBox Err.Number & vbCr & Err.Description
Err.Clear
GoTo lbl_Exit
End Sub

[nrk]

Thanks you gmayor its amazing:yes