我设置了自动执行电子邮件提醒的代码。它运作良好,但现在我要负责添加更多功能。我是编码的初学者。
我受命将图片附加到这些电子邮件中。基本上,我想使用一个“主题”来触发拉特定的图片。例如,主题“ MS01:订购XYZ”和“ MS02:领取XYZ”。如果MS01是特定列,则vba将在电子邮件正文中拉出并附加与MS01绑定的HTML图片,等等。
这将如何工作?
Public Sub SendReminderMail()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim dueRows() As Double 'number of days left.. between 3 and 14'
Dim arraySize As Double
Dim Number As Double
'Using while loop to scan for data with due dates between 3 and 14 days'
arraySize = WorksheetFunction.CountA(Columns(3))
ReDim dueRows(arraySize) 'Setting array size'
'Using the subject field to check -> Not everyone's email might be in'
For iCounter = 1 To arraySize
'Check to know if it is a string or number'
If IsNumeric(Cells(iCounter, 9).Value) = True Then
Number = Cells(iCounter, 9).Value
'Test for anything between 3 and 14 days'
If Number >= 0 And Number < 15 Then
'Populate Array'
dueRows(iCounter) = Number
'Color code Yellow with Black Font'
Cells(iCounter, 7).Interior.Color = RGB(246, 229, 141)
Cells(iCounter, 7).Font.Color = RGB(47, 54, 64)
Cells(iCounter, 7).Font.Bold = True
ElseIf Number <= 3 Then
dueRows(iCounter) = Number
'Color code Red with white font'
Cells(iCounter, 7).Interior.Color = RGB(192, 57, 43)
Cells(iCounter, 7).Font.Color = RGB(241, 242, 246)
Cells(iCounter, 7).Font.Bold = True
Else
'White and Black'
dueRows(iCounter) = 0
Cells(iCounter, 7).Interior.Color = RGB(255, 255, 255)
Cells(iCounter, 7).Font.Color = RGB(30, 39, 46)
Cells(iCounter, 7).Font.Bold = False
End If
End If
Next iCounter
'Emailing Time'
For iCounter = 1 To arraySize
'if not between 3 and 14'
If dueRows(iCounter) <> 0 Then
' if 0-3,5,7 or 14 send periodic email'
If dueRows(iCounter) = 1 Or dueRows(iCounter) = 2 Or dueRows(iCounter) = 3 Or dueRows(iCounter) = 7 Or dueRows(iCounter) = 14 Then
Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
.To = Cells(iCounter, 6).Value
.CC = Cells(iCounter, 10).Value
.HTMLBody = "<BODY style=font-size:11pt;font-family:Garamond>" & Cells(iCounter, 4).Value
.Subject = Cells(iCounter, 3).Value & " for " & Cells(iCounter, 1).Value & " " & Cells(iCounter, 2).Value & " is due in " & dueRows(iCounter) & " day(s)."
.Send
End With
ElseIf dueRows(iCounter) = 0 Then
Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
.To = Cells(iCounter, 6).Value
.CC = Cells(iCounter, 10).Value
.HTMLBody = "<BODY style=font-size:11pt;font-family:Garamond>" & Cells(iCounter, 4).Value
.Subject = Cells(iCounter, 3).Value & " for " & Cells(iCounter, 1).Value & " " & Cells(iCounter, 2).Value & " is due today"
.Send
End With
ElseIf dueRows(iCounter) < 0 And dueRows(iCounter) > -100 Then
Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
.To = Cells(iCounter, 6).Value
.CC = Cells(iCounter, 10).Value
.HTMLBody = "<BODY style=font-size:11pt;font-family:Garamond>" & Cells(iCounter, 4).Value
.Subject = Cells(iCounter, 3).Value & " for " & Cells(iCounter, 1).Value & " " & Cells(iCounter, 2).Value & " is overdue by " & dueRows(iCounter) & " day(s)."
.Send
End With
End If
End If
Next iCounter
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub