Sending attachments with emails

[fusion001]

I have a code which I want to use to send emails with attachments. I have a report which has the report name in column A and the recipient email address in column B. It appears that it is missing off every second line, so it sends an email to recipient on row 1, row 3, row 5 etc. I'm not sure why this is happening. Can anyone spot something on this code? Thanks

Sub email()
Dim sht As Worksheet
Dim myfiles() As String
'Dim strEmailText As String
Set sht = Sheets("sheet1")     
sht.UsedRange.Sort sht.Range("b:b"), , , , , , , xlNo ' xlyes for header row
myfilepath = "C:\Reports\"


Set myOutlook = GetObject(, "Outlook.Application")
Set myMessage = myOutlook.CreateItem(0)
rw = 0    ' change to 1 if you want to have a header row
Do Until IsEmpty(sht.Cells(rw + 1, 2))
rw = rw + 1
      With myMessage

        .SentOnBehalfOfName = "JM@hm.com"
        .To = sht.Cells(rw, 2)
        .Subject = "Reports"
        '.BodyFormat = olFormatHTML
        .body = "Please find attached reports"



        myfiles = Split(Sheets("sheet1").Cells(rw, 1), ";")

        For a = 0 To UBound(myfiles)
           ext = ".xlsx"
           'If Len(Dir(myfilepath & myfiles(a) & ext)) = 0 Then MsgBox myfilepath & myfiles(a) & ext & " not found"
            .Attachments.Add myfilepath & myfiles(a) & ext
   
        Next
        If Not sht.Cells(rw, 2) = sht.Cells(rw + 1, 2) Then
         .Attachments.Add myfilepath & "Letter.docx"
         .Send
         Set myMessage = myOutlook.CreateItem(0)
        End If
        rw = rw + 1
    End With

Loop
 'oboutlook.Quit
 'Set oboutlook = Nothing


End Sub

[westconn1]

you have rw = rw +1 in 2 places, should only be in one

[fusion001]

you have rw = rw +1 in 2 places, should only be in one

Thanks so much.

[fusion001]

Is there a piece of code that I can add to skip any rows where it doesn't find a report? At the moment each time a report is not found the code stops. Thanks

[westconn1]

you could try like

Do Until IsEmpty(sht.Cells(rw + 1, 2))
rw = rw + 1
    if not isempty(sht.Cells(rw, 1)) then
      With myMessage
        .SentOnBehalfOfName = "JM@hm.com"
        .To = sht.Cells(rw, 2)
        .Subject = "Reports"
        '.BodyFormat = olFormatHTML
        .body = "Please find attached reports"



        myfiles = Split(sht.Cells(rw, 1), ";")

        For a = 0 To UBound(myfiles)
           ext = ".xlsx"
           'If Len(Dir(myfilepath & myfiles(a) & ext)) = 0 Then MsgBox myfilepath & myfiles(a) & ext & " not found"
            .Attachments.Add myfilepath & myfiles(a) & ext
   
        Next
        If Not sht.Cells(rw, 2) = sht.Cells(rw + 1, 2) Then
         .Attachments.Add myfilepath & "Letter.docx"
         .Send
         Set myMessage = myOutlook.CreateItem(0)
        End If

    End With
  end if
Loop

i have not checked all the code, so test carefully