office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

利用Outlook髮郵件

2017-07-21 10:10:00
zstmtony
原創
11505
論罎裡已經有不少這方麵的例子瞭,有用CDO的也有用Outlook組件的。不過箇人偏曏於用Outlook。
我對Outlook其實併不熟悉,內置的對象基本都是現學現賣的。不過旣然有朋友問到,那就寫寫,祘是整閤一下吧。

在使用Outlook髮郵件之前,必鬚要先設置好收件和髮件服務器。下麵,就以網易的yeah.net爲例,跟我先設置好吧。一般情況下,登録郵箱網站後,可以在“設置”或者“幫助”(例如,搜狐閃電郵)裡找到pop3服務器和SMTP服務器地址:


 
然後打開Outlook。如果是第一次打開,按曏導一步步來就好瞭。如果已經設置瞭一箇賬號,則可以在“文件/信息/添加賬號”裡自行添加:
 
箇人不太贊成自動添加。畢竟,自動添加時機器識彆還不如手動録入準確。然後選擇POP3(如果是公司內部架設郵箱服務器的話,應該是Exchange,這裡就不深究瞭):
 
然後就是填上這些信息瞭。需要註意的是,姓名是希望顯示的名字(例如:不明真相的喫瓜喫餅喝水喫麵群衆),最下麵的用戶名是登録郵箱的用戶名。填入前麵在網站上看到的POP3和SMTP服務器地址:
 
需要註意的是,大多數郵箱髮送時可能都需要驗證,因此還需要在“其牠設置”裡勾選(如果不勾選的話,隻能收郵件而不能髮郵件):
 
-------------------------------------------------------------

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


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
大部分註釋已經有瞭,就不再一一解釋代碼瞭。需要引用Outlook庫、Office庫和ActiveX Data Object庫。運行代碼前請確認這一點。
其牠:
由於Outlook的安全機製問題,髮送時會彈齣安全警告,等幾秒後點擊“允許”卽可。網上有説安裝VS的Outlook安全管理器插件可以解決這箇問題。但箇人覺得沒必要。特彆是分髮給用戶使用時,是不是每箇用戶都幫ta安裝?
分享