2015-10-18 1 views
-2
Sub SendReminderMail() 
    Dim OutlookApp As Object 
    Dim OutLookMailItem As Object 
    Dim iCounter As Integer 
    Dim MailDest As String 

    Set OutlookApp = CreateObject("Outlook.application") 
    Set OutLookMailItem = OutlookApp.CreateItem(0) 

    With OutLookMailItem 
    MailDest = "" 

    For iCounter = 1 To WorksheetFunction.CountA(Columns(34)) 
     If MailDest = "" And Cells(iCounter, 34).Offset(0, -1) = "Send Reminder" Then 
     MailDest = Cells(iCounter, 34).Value 
     ElseIf MailDest <> "" And Cells(iCounter, 34).Offset(0, -1) = "Send Reminder" Then 
     MailDest = MailDest & ";" & Cells(iCounter, 34).Value 
     End If 
    Next iCounter 

    .BCC = MailDest 
    .Subject = "ECR Notification" 
    .HTMLBody = "Reminder: This is a test for an automatic ECR email notification. Please complete your tasks for ECR#" 
    .Send 
    End With 

    Set OutLookMailItem = Nothing 
    Set OutlookApp = Nothing 
End Sub 

Нужна код по электронной почте значения в столбцах AE с "установить напоминание" текстКак отправить по электронной почте напоминание от кода

enter image description here

+1

GD MJac, Пожалуйста, измените свой вопрос, чтобы код отображался как код и сообщал, что вы пробовали до сих пор, что не работает. Получают сообщения об ошибках. Дайте объяснение, что должен сделать ваш образец кода entrie. Ваш вопрос не содержит достаточной информации и не имеет точности в заданном вопросе. – mtholen

ответ

0

GD mjac,

Вы все еще стесняюсь вашей информацией ...?

Ваш представленный код собирает все адреса и затем отправляет одно сообщение? Я ожидал бы, основываясь на вашем примере листа/данных, который вы хотели бы отправить электронному письму каждому получателю для каждого кода ECR, который является «открытым»?

Так предполагая следующее:

  • Вы хотите отправить электронную почту для каждой строки, где «Отправить напоминание» является истинных
  • адреса электронной почты, в столбцах «AH» будет отличаться для каждой строки?

В своем коде вы используете Outlook.Application объекты Set OutlookApp = CreateObject("Outlook.application"), будьте осторожны с объектами типа приложения открытия и обязательно убедиться, что они будут закрыты в случае код заканчивается, или когда срабатывают ошибку, в противном случае вы могли бы потенциально в конечном итоге с несколькими экземплярами Outlook, которые «работают», используя ценные ресурсы. В приведенном ниже коде есть некоторая базовая обработка ошибок, чтобы объект OutlookApp был закрыт, если больше не требуется.

Настройте Workbook следующим образом:

В VB редактора в разделе Инструменты | Ссылки найти «Microsoft Outlook XX.X Библиотека объектов», где xx.x представляет версию Outlook, что вы работаете. (см. также: https://msdn.microsoft.com/en-us/library/office/ff865816.aspx). Это упростит кодирование, поскольку вы получите предложения intellisense для своих объектов.

Объявить OutlookApp в общественных местах, выше всех других Subs/функций и т.д. и т.п. (т.е. в верхней части 'кодирования' окна)

Public OutlookApp As Outlook.Application 

ваш sendReminderMail() к югу

Sub SendReminderMail() 
    Dim iCounter As Integer 
    Dim MailDest As String 
    Dim ecr As Long 

    On Error GoTo doOutlookErr: 
    Set OutlookApp = New Outlook.Application 

    For iCounter = 1 To WorksheetFunction.CountA(Columns(34)) 
     MailDest = Cells(iCounter, 34).Value 
     ecr = Cells(iCounter, 34).Offset(0, -3).Value 

     If Not MailDest = vbNullString And Cells(iCounter, 34).Offset(0, -1) = "Send Reminder" Then 
      sendMail MailDest, ecr 
      MailDest = vbNullString 
     End If 

    Next iCounter 

'basic errorhandling to prevent Outlook instances to remain open in case of an error. 
doOutlookErrExit: 
    If Not OutlookApp Is Nothing Then 
     OutlookApp.Quit 
    End If 
    Exit Sub 

doOutlookErr: 
    MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number 
    Resume doOutlookErrExit 

End Sub 

добавил Sendmail Функция:

Function sendMail(sendAddress As String, ecr As Long) As Boolean 

    'Initiate function return value 
    sendMail = False 
    On Error GoTo doEmailErr: 

    'Initiate variables 
    Dim OutLookMailItem As Outlook.MailItem 
    Dim htmlBody As String 

    'Create the mail item 
    Set OutLookMailItem = OutlookApp.CreateItem(olMailItem) 

    'Create the concatenated body of the mail 
    htmlBody = "<html><body>Reminder: This is a test for an automatic ECR email notification.<br>" & _ 
       "Please complete your tasks for ECR#" & CStr(ecr) & "</body></html>" 

    'Chuck 'm together and send 
    With OutLookMailItem 

     .BCC = sendAddress 
     .Subject = "ECR Notification" 
     .HTMLBody = htmlBody 
     .Send 

    End With 

    sendMail = True 

doEmailErrExit: 
    Exit Function 

doEmailErr: 
    MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number 
    Resume doEmailErrExit 


End Function 
+0

mtholen, Это впечатляет. Ваши предположения были на месте. Приношу свои извинения за то, что я не передал свой вопрос правильно, поскольку я новичок во всей среде программирования. Единственный вопрос, который у меня остается, - как я могу сделать шрифт значения ecr жирным? Это с синтаксисом .Font.Bold = True – mjac

+0

GD Mjac, самым простым способом было бы добавить перед «& Cstr (ecr) &» и после него. То есть«Пожалуйста, заполните ваши задачи для ECR # » & CStr (ecr) & «« Если этот ответ отвечает на ваш вопрос, тогда примите ответ, нажав значок «Принять» под стрелками для голосования в верхней части вопроса. – mtholen

Смежные вопросы