利用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