利用Outlook發(fā)郵件

至此，設(shè)置結(jié)束。接下來就是寫代碼完成發(fā)送的過程了：

Function SendMailToAll(ByVal strSubject As String, ByVal strBody As String, Optional ByVal blnAttachment As Boolean = False)
    '定義Outlook組件
    Dim appOutlook As New Outlook.Application
    Dim objMailItem As Outlook.MailItem
    
    '定義記錄集，用于讀取郵箱列表
    Dim rst As New ADODB.Recordset
    Dim strMailAddress As String
    
    '定義文件拾取器，用于添加多個(gè)附件。
    Dim fd As FileDialog
    Dim i As Long
    
    Set objMailItem = appOutlook.CreateItem(olMailItem)
    
    With objMailItem
    
        '打開郵箱列表并在讀取完畢后關(guān)閉郵箱列表
        rst.Open "tblMailingList", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
            Do Until rst.EOF
                strMailAddress = strMailAddress & rst(1) & ";"
                rst.MoveNext
            Loop
        .To = strMailAddress
        rst.Close
        Set rst = Nothing
        
        '設(shè)置主題和主體，如需格式化文本，請(qǐng)使用HTMLBody屬性，并編寫HTML代碼：
        .Subject = strSubject
        .Body = strBody
        
        '.HTMLBody = "<P style=""color:red;font-size:14px;font-weight:700"">" & strBody & "</p>"
        
        '是否上傳附件。如需上傳，則打開文件拾取器。
        If blnAttachment Then
            If MsgBox("您已經(jīng)選擇了上傳附件，為了便于一次上傳多個(gè)附件，請(qǐng)務(wù)必確保所有附件都在同一個(gè)文件夾內(nèi)。", vbYesNoCancel) = vbYes Then
                Set fd = Application.FileDialog(msoFileDialogFilePicker)
                fd.AllowMultiSelect = True
                If fd.SHOW = -1 Then
                    For i = 1 To fd.SelectedItems.Count
                        .Attachments.Add fd.SelectedItems(i), olByValue, , Mid(fd.SelectedItems(i), InStrRev(fd.SelectedItems(i), "") + 1, Len(fd.SelectedItems(i)))
                    Next
                End If
            End If
        End If
        
        .Send
    End With
End Function