Hi all,
Every month I have to send several recipients an email with information from an excel table in order to confirm price and volume. Customers may have to confirm more than one item and might also have already settle others.
So, I wrote a code in order to automatize this. It basically goes like this:
It only gets the information from the table of the lines which are not hidden. Once it gets a line it filters all the lines with the same customer, copies the lines and creates the e-mail. After this it cleans the filter, and goes to the next x. If the row with the x is the same as x-1, it jumps to the next one until it finds the following customer.
The macro works perfectly if I run it manually (F8). However, when I’m not running it manually it gets an error randomly between the recipients. At first I thought that the e-mails addresses may be wrong, but they are right, even the format is the same.
Would anybody be able to help me with this?
Every month I have to send several recipients an email with information from an excel table in order to confirm price and volume. Customers may have to confirm more than one item and might also have already settle others.
So, I wrote a code in order to automatize this. It basically goes like this:
It only gets the information from the table of the lines which are not hidden. Once it gets a line it filters all the lines with the same customer, copies the lines and creates the e-mail. After this it cleans the filter, and goes to the next x. If the row with the x is the same as x-1, it jumps to the next one until it finds the following customer.
The macro works perfectly if I run it manually (F8). However, when I’m not running it manually it gets an error randomly between the recipients. At first I thought that the e-mails addresses may be wrong, but they are right, even the format is the same.
Would anybody be able to help me with this?
Code:
Dim OutApp As Object 'Outlook.Application
Dim OMail As Object 'Outlook.MailItem
Dim signature As Range 'String
Dim LastRow As Long
Dim LastRow1 As Long
Dim contacts As String
Dim Subj As String
Dim tbody As String
Dim rng As Range
Sub mailalg()
'asks if you are sure to send the email
If MsgBox("Send Email?", vbYesNo + vbQuestion, "Email") = vbYes Then
Application.ScreenUpdating = False
‘looks for last row in table
LastRow = Sheets(1).Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
'signature
Set signature = Sheets("E-mail input").Cells(2, 1)
'hide unnecesary columns
Sheets(1).Columns("K:J").EntireColumn.Hidden = True
'e-mail subject & body
Subj = Sheets("E-mail input").Cells(3, 11) & " " & Format(Sheets("E-mail input").Cells(3, 13), "mmmm yyyy")
tbody = Sheets("E-mail input").Cells(20, 1) & "
" & _
Sheets("E-mail input").Cells(21, 1) & Format(Sheets("E-mail input").Cells(3, 13), "mmmm yyyy") & "
"
'looks each line and prepares e-mail
For x = 15 To LastRow
'if the line is hidden it jumps to the next one
If Sheets(1).Rows(x).Hidden = True Then
GoTo 5
End If
'if the line e-mail is = as the one in the line before, it jumps to the next line
If Sheets(1).Cells(x, 1) = Sheets(1).Cells(x - 1, 1) Then
GoTo 5
End If
'filter all the information to be sent to the same address
Sheets(1).Range("$A$1:$F$" & x).AutoFilter Field:=1, Criteria1:=Sheets(1).Cells(x, 1).Value
‘looks again for the last row now filtered
LastRow1 = Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row
Set rng = Nothing
Set rng = Sheets(1).Range(Sheets(1).Cells(14, 3), Sheets(1).Cells(LastRow1, 15)).SpecialCells(xlCellTypeVisible)
'create the e-mail
Set OutApp = CreateObject("Outlook.Application")
Set OMail = OutApp.CreateItem(olMailItem)
With OMail
On Error GoTo 6
‘’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’HERE’S THE ERROR
.To = Sheets(1).Cells(x, 1)
On Error GoTo 0
.Subject = Subj
.HTMLBody = tbody & RangetoHTML(rng) & vbNewLine & RangetoHTML(signature)
.Display
'.send
End With
'unfilter the information
Sheets(1).Range("$A$1:$F$" & x).AutoFilter Field:=1
5 Next x
'unhides the hidden columns
Sheets(1).Columns("K:J").EntireColumn.Hidden = False
Application.ScreenUpdating = True
Set OutApp = Nothing
End If
Exit Sub
'if it has an issue with the e-mails pops up this msg
6 MsgBox ("Please check the e-mails for " & Cells(x, 5))
'unfilter the information
Sheets(1).Range("$A$1:$F$" & x).AutoFilter Field:=1
GoTo 5
End Sub
