利用Outlook髮郵件

至此，設置結束。接下來就是寫代碼完成髮送的過程瞭：

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
    
    '定義文件拾取器，用於添加多箇附件。
    Dim fd As FileDialog
    Dim i As Long
    
    Set objMailItem = appOutlook.CreateItem(olMailItem)
    
    With objMailItem
    
        '打開郵箱列錶併在讀取完畢後關閉郵箱列錶
        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
        
        '設置主題和主體，如需格式化文本，請使用HTMLBody屬性，併編寫HTML代碼：
        .Subject = strSubject
        .Body = strBody
        
        '.HTMLBody = "<P style=""color:red;font-size:14px;font-weight:700"">" & strBody & "</p>"
        
        '是否上傳附件。如需上傳，則打開文件拾取器。
        If blnAttachment Then
            If MsgBox("您已經選擇瞭上傳附件，爲瞭便於一次上傳多箇附件，請務必確保所有附件都在衕一箇文件夾內。", 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