【分享成果，隨喜正能量】不必去責怪你生命中的任何人和事，來路縱有坎坷，卻也教會了你堅強；過往有遺憾，卻也讓你收穫了成長。寬容是一種大智慧。“大肚能容，容天下難容之事；開口便笑，笑世間可笑之人”，彌勒佛在心中，非在眼中。在眼中時時觀瞻，刻刻仰止，一旦風生水起，只配得到他老人家的睥睨 。
《VBA資訊獲取與處理》教程是我推出第六套教程，目前已經是第一版修訂了。這套教程定位於最高階，是學完初級，中級後的教程。這部教程給大家講解的內容有：跨應用程式資訊獲得、隨機資訊的利用、電子郵件的傳送、VBA網際網路資料抓取、VBA延時操作，剪貼簿應用、Split函式擴充套件、工作表資訊與其他應用互動，FSO物件的利用、工作表及資料夾資訊的獲取、圖形資訊的獲取以及定製工作表資訊函式等等內容。程式檔案透過32位和64位兩種OFFICE系統測試。是非常抽象的，更具研究的價值。
教程共兩冊，八十四講。今日的內容是專題五“利用VBA傳送電子郵件”的第3講：VBA利用郵箱伺服器傳送電子郵件
第三節 利用其他郵箱伺服器傳送電子郵件
在第一和第二節中，我講解了如何實現利用EXCEL屬性設定完成郵件的傳送，但很多時候，我們並不是喜歡用OUTLOOK來發送郵件，你可能用的是126的郵箱，可能用的是163的郵箱，等等，那麼如何實現利用這些郵件伺服器來發送郵件呢？我們這節的內容就給大家以很好的解決方案。
這是我根據我多年的經驗編寫的第六部教程，這些教程不是單純的知識講解更主要的經驗的傳遞，所有的教程中體現的是“積木程式設計”的思路，大家可以利用我推出的程式碼，用於實際工作中，儘可能是去修改我推出的程式碼為自己所用，而不是自己去寫程式碼，那樣會很不準確，比如有的朋友讓我給測試一段無法執行的程式碼，我測試後發現就是因為其中一個nothing寫成了nohting，更有甚者，是由於逗號的全形問題不能透過，這些問題大家要儘可能的去避免。這講的程式碼同樣，不要大家去一個個的錄入字元，要去用我的程式碼，然後去修正為自己的設定即可。
下面言歸正傳，我們講解利用其它郵件伺服器完成我們的郵件傳送，我要傳送的是包含兩個附件的郵件，同時，郵件的主題內容部分是我在事前已經寫好到一個文字檔案中。我要將這個郵件利用指定的郵箱傳送給指定的郵箱。
1 利用郵箱伺服器傳送郵件的思路分析
由於要利用郵件伺服器來完成郵件的傳送工作，所以我們要完成對郵件伺服器以下必要引數的設定，如傳送郵件的郵箱地址；傳送郵箱的伺服器；傳送郵箱的登陸密碼；收件人的郵箱地址等等，這個過程看起來是較複雜的，但確實必不可少的關鍵步驟。除了要完成 上述設定外還要去其他的一些操作上必要的工作，為了能順利的實現我們任務，我們大概的做一個清單：
1）程式碼需要引用Microsoft CDO for Windows 2000庫，來完成我們的郵件傳送工作。
2）由於用到的引數較多，有傳送郵件的郵箱地址；傳送郵箱的伺服器；傳送郵箱的登陸密碼；收件人的郵箱地址；附件的引用；郵件正文的讀取檔案，等等，所以在程式碼的實現過程中我們將建立一個function過程來實現郵件的傳送。如果郵件傳送程式將返回TRUE，如果不成功那麼返回false。
3）在主程式過程中提供上述的引數，並接受函式的返回值，如果為true那麼就提示使用者郵件傳送成功，否則提示沒有成功。
4）在function過程中要校驗各個引數是否正常。
5）在function過程中，要開啟需要寫入郵件正文的文字檔案，然後讀取，寫入郵件。
6） 在function過程中要完成附件的新增。在主程式工程中將把每個附件的名稱（full name）設定成陣列的元素，在function過程中要先判斷輸入的是否為陣列，如果為陣列那麼拆分陣列後逐個新增附件。
2 利用郵箱伺服器傳送郵件過程中的主程式程式碼
思路確定之後，我們要一步步的完成我們的工作，首先要完成主程式過程的程式碼設計，我們在上述思路的清點過程中已經明確了主程式要實現的工作有：必要引數的傳遞和接受fountion過程的返回值，下面看程式碼的過程：
Sub myNZB（）
myBRR = Array（“D：\06VBA資訊獲取與處理（修訂一版）\005關於安全生產的通知。TXT”， “D：\06VBA資訊獲取與處理（修訂一版）\005關於安全生產的通知。docx”）
If NN = True Then
MsgBox “郵件傳送成功！”
Else
MsgBox “郵件沒有傳送成功！”
End If
End Sub
程式碼的截圖：
程式碼的講解：
1） myBRR = Array（“D：\06VBA資訊獲取與處理（修訂一版）\005關於安全生產的通知。TXT”， “D：\06VBA資訊獲取與處理（修訂一版）\005關於安全生產的通知。docx”） 這句程式碼將要新增的附件放到了陣列中。
這段程式碼是利用SendEMailB （）函式來完成郵件的傳送。傳遞的引數有：
Subject：=“My Email”
MailBody：=“”，
BodyFileName：=“E：\NZ\文章\06 VBA資訊獲取與處理\005關於安全生產的通知。TXT”
Attachments：=myBRR
下面我們還會提到各個引數的意義。
3）If NN = True Then
MsgBox “郵件傳送成功！”
Else
MsgBox “郵件沒有傳送成功！”
End If
上述程式碼根據返回值的不同，從而判斷郵件是否傳送成功。
3 利用郵箱伺服器傳送郵件過程中FUNCTION過程的實現程式碼
在上面的講解中利用了SendEMailB （）這個函式過程來發送郵件，我們來看看這個過程的具體實現步驟，程式碼如下：
Function SendEMailB（Subject As String， FromAddress As String， ToAddress As String， _
MailBody As String， _
SMTP_Server As String， _
BodyFileName As String， _
Optional Attachments As Variant = Empty） As Boolean
‘常量的命名
Const cdoSendUsingMethod = “http：//schemas。microsoft。com/cdo/configuration/sendusing”
Const cdoSendUsingPort = 2
Const cdoSMTPServer = “http：//schemas。microsoft。com/cdo/configuration/smtpserver”
Const cdoSMTPServerPort = “http：//schemas。microsoft。com/cdo/configuration/smtpserverport”
Const cdoSMTPConnectionTimeout = “http：//schemas。microsoft。com/cdo/configuration/smtpconnectiontimeout”
Const cdoSMTPAuthenticate = “http：//schemas。microsoft。com/cdo/configuration/smtpauthenticate”
Const cdoBasic = 1
Const cdoSendUserName = “http：//schemas。microsoft。com/cdo/configuration/sendusername”
Const cdoSendPassword = “http：//schemas。microsoft。com/cdo/configuration/sendpassword”
Dim objConfig
Dim objMessage
Dim Fields
’ 確保所需引數存在且有效
If Len（Trim（Subject）） = 0 Then
SendEMailB = False
Exit Function
End If
If Len（Trim（FromAddress）） = 0 Then
SendEMailB = False
Exit Function
End If
If Len（Trim（SMTP_Server）） = 0 Then
SendEMailB = False
Exit Function
End If
‘傳入的引數
’ Subject： 電子郵件的主題行。
‘ FromAddress： 是傳送電子郵件的地址
’ ToAddress： 是電子郵件將傳送到的地址
‘ MailBody： 要作為郵件正文的文字。
’ SMTP_Server： 是傳出郵件伺服器的名稱。
‘ BodyFileName： 是將用作訊息正文的文字檔案的名稱。
’ Attachments 要附加到郵件的單個檔名或檔名陣列。
‘引用
Set objMessage = CreateObject（“CDO。Message”）
’物件的引用
Set objConfig = objMessage。Configuration
Set Fields = objConfig。Fields
With Fields
。Item（cdoSendUsingMethod） = cdoSendUsingPort
。Item（cdoSMTPServerPort） = 25
。Item（cdoSMTPConnectionTimeout） = 10
。Item（cdoSMTPAuthenticate） = cdoBasic
。Item（cdoSendUserName） = FromAddress ‘
。Item（cdoSendPassword） = “******” ’
。Update
End With
‘郵件的設定
With objMessage
’。BodyPart。Charset = “shift-jis” ‘
。To = ToAddress ’
。From = FromAddress ‘
。Subject = Subject ’
‘ 。htmlBody ’
‘假如傳入的引數有內容則引用，也可以從檔案中匯入
If MailBody vbNullString Then
。htmlBody = MailBody
Else
If BodyFileName vbNullString Then
If Dir（BodyFileName， vbNormal） vbNullString Then
’ 從檔案BodyFileName匯入正文文字
FNum = FreeFile
S = vbNullString
Body = vbNullString
Open BodyFileName For Input Access Read As #FNum
Do Until EOF（FNum）
Line Input #FNum， S
Body = Body & vbNewLine & S
Loop
Close #FNum
。htmlBody = Body
Else
‘BodyFileName 沒有發現
SendEMailB = False
Exit Function
End If
End If ’ MailBody and BodyFileName 都為空
End If
‘新增附件
If IsArray（Attachments） = True Then
’ 附加附件的所有檔案。
For N = LBound（Attachments） To UBound（Attachments）
‘ 如果為陣列將每個檔案傳入
If Attachments（N） vbNullString Then
If Dir（Attachments（N）， vbNormal） vbNullString Then
。AddAttachment Attachments（N）
End If
End If
Next
Else
’ 不為陣列則傳入檔案
If Attachments vbNullString Then
If Dir（CStr（Attachments）， vbNormal） vbNullString Then
。AddAttachment Attachments
End If
End If
End If
‘判斷郵件是否傳送成功
On Error Resume Next
Err。Clear
。Send
tt = Err。Number
If Err。Number = 0 Then
SendEMailB = True
Else
SendEMailB = False
Exit Function
End If
End With
Set Fields = Nothing
Set objMessage = Nothing
Set objConfig = Nothing
End Function
程式碼的截圖：
程式碼的解讀：
1）’ 確保所需引數存在且有效
If Len（Trim（Subject）） = 0 Then
SendEMailB = False
Exit Function
End If
If Len（Trim（FromAddress）） = 0 Then
SendEMailB = False
Exit Function
End If
If Len（Trim（SMTP_Server）） = 0 Then
SendEMailB = False
Exit Function
End If
‘傳入的引數
’ Subject： 電子郵件的主題行。
‘ FromAddress： 是傳送電子郵件的地址
’ ToAddress： 是電子郵件將傳送到的地址
‘ MailBody： 要作為郵件正文的文字。
’ SMTP_Server： 是傳出郵件伺服器的名稱。
‘ BodyFileName： 是將用作訊息正文的文字檔案的名稱。
’ Attachments 要附加到郵件的單個檔名或檔名陣列。
上述程式碼確保了各個引數的有效性，同時給出了各個引數的意義。當所給的引數是無效的將不能傳送郵件，這個很好理解的例如傳送郵箱和接受郵箱是空的話自然不能傳送郵件的。
2） Set objMessage = CreateObject（“CDO。Message”） 這句程式碼是對CDO的引用，我們傳送郵件也是依據這個引用來完成的。
3）With Fields
。Item（cdoSendUsingMethod） = cdoSendUsingPort
。Item（cdoSMTPServerPort） = 25
。Item（cdoSMTPConnectionTimeout） = 10
。Item（cdoSMTPAuthenticate） = cdoBasic
。Item（cdoSendUserName） = FromAddress ‘
。Item（cdoSendPassword） = “*****” ’
。Update
End With
以上過程是對郵件的設定包括髮送郵件的伺服器及密碼，大家在利用的時候注意要修改為自己的郵箱及密碼設定。
4）With objMessage
‘。BodyPart。Charset = “shift-jis” ’
。To = ToAddress ‘
。From = FromAddress ’
。Subject = Subject ‘
’ 。htmlBody ‘
上述程式碼是對郵件的設定，比較簡單，這裡不再多講，下面將對郵件主題內容進行設定。
5）’假如傳入的引數有內容則引用，也可以從檔案中匯入
If MailBody vbNullString Then
。htmlBody = MailBody
Else
If BodyFileName vbNullString Then
If Dir（BodyFileName， vbNormal） vbNullString Then
‘ 從檔案BodyFileName匯入正文文字
FNum = FreeFile
S = vbNullString
Body = vbNullString
Open BodyFileName For Input Access Read As #FNum
Do Until EOF（FNum）
Line Input #FNum， S
Body = Body & vbNewLine & S
Loop
Close #FNum
。htmlBody = Body
Else
’BodyFileName 沒有發現
SendEMailB = False
Exit Function
End If
End If ‘ MailBody and BodyFileName 都為空
End If
上述程式碼完成了郵件主題從另外的檔案中進行內容讀取的設定，如果有對Input語句不是十分理解的朋友可以參考我的其他教程，在資料庫及準資料庫中均有講解。
6）’新增附件
If IsArray（Attachments） = True Then
‘ 附加附件的所有檔案。
For N = LBound（Attachments） To UBound（Attachments）
’ 如果為陣列將每個檔案傳入
If Attachments（N） vbNullString Then
If Dir（Attachments（N）， vbNormal） vbNullString Then
。AddAttachment Attachments（N）
End If
End If
Next
Else
‘ 不為陣列則傳入檔案
If Attachments vbNullString Then
If Dir（CStr（Attachments）， vbNormal） vbNullString Then
。AddAttachment Attachments
End If
End If
End If
上述程式碼完成了對附件的新增過程，涉及到陣列的拆分，檔名的判斷，附件的新增。
7）’判斷郵件是否傳送成功
On Error Resume Next
Err。Clear
。Send
tt = Err。Number
If Err。Number = 0 Then
SendEMailB = True
Else
SendEMailB = False
Exit Function
End If
上述程式碼完成了對郵件是否傳送成功的判斷，在整個傳送過程中，如果沒有發生錯誤，那麼返回值是：SendEMailB = True，否則為false
4 利用郵箱伺服器傳送郵件的結果
透過主程式和函式過程的實現，我們終於可以完成郵件的傳送了，如下圖，我們點選執行按鈕：
以上就是整個郵件傳送的過程，這個工程中沒有必要要求傳送郵件的伺服器是開啟狀態。
本節知識點回向：如何實現利用郵件伺服器傳送郵件？如何讀取指定的檔案放到郵件中？如果實現多附件的郵件傳送？
本專題參考程式檔案：005工作表。XLSM
我20多年的VBA實踐經驗，全部濃縮在下面的各個教程中，教程學習順序：
