office交流網--QQ交流群號

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

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

利用Outlook發郵件

2017-07-21 10:10:00
zstmtony
原創
5692
論壇里已經有不少這方面的例子了,有用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安裝?
分享
北京十一选五基本走势