2015-10-18 51 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,請更改您的問題,以便代碼實際顯示爲代碼並提供您迄今嘗試過的內容,哪些內容不起作用。你收到錯誤消息嗎?給出一個解釋你的代碼樣本應該做什麼。你的問題沒有包含足夠的信息,並且在問題中缺乏精確性。 – mtholen

回答

0

GD mjac,

你是仍然害怕你的信息...?

您提供的代碼收集所有地址並隨後發送一條消息?我希望根據您的示例表/數據,您希望爲每個「打開」的ECR代碼發送電子郵件給每個收件人?

因此,假設如下:

  • 你想發送一封電子郵件,每行,其中列「發送提醒」是 真
  • 電子郵件地址「AH」將爲每行有什麼不同?

在你的代碼使用Outlook.Application對象Set OutlookApp = CreateObject("Outlook.application"),小心打開的應用程序類型的對象,一定要確保他們將在代碼完成的事件或當觸發一個錯誤,否則可能會關閉可能最終會產生許多使用有價值的資源「運行」的Outlook實例。下面的代碼具有一些基本的錯誤處理,以確保OutlookApp對象在不再需要時關閉。

設置您的工作簿,如下所示:

在VB編輯器下工具|引用找到「Microsoft Outlook中XX.X對象庫」,其中XX.X表示您正在使用的Outlook版本。 (另請參閱:https://msdn.microsoft.com/en-us/library/office/ff865816.aspx)當您爲對象獲得智能感知建議時,這將使編碼更輕鬆。

聲明OutlookApp爲公共,上述所有其它潛艇/功能等等,等等 (即,在您的 '編碼' 窗口的頂部)

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 

added 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