我正在自动执行电子邮件提醒,需要帮助将图片添加到文件中

时间:2019-07-17 17:24:18

标签: excel vba

我设置了自动执行电子邮件提醒的代码。它运作良好,但现在我要负责添加更多功能。我是编码的初学者。

我受命将图片附加到这些电子邮件中。基本上,我想使用一个“主题”来触发拉特定的图片。例如,主题“ 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

0 个答案:

没有答案