用VBS腳本發郵件

需求是這樣的：針對賬號的管理，如果發現該賬號的管理員給賬號加了批注，（比如要過期，修改密碼，完善資料等），就需要找到這樣的賬號及其管理的郵件，然后發郵件給他們的管理員同時抄送給賬號以達到提醒的目的。那么我們的實際項目中是這樣管理的：

有三個表，第一張表用來存放賬號的所有信息，以及這個賬號的備注，第二張表存放了賬號信息以及他的管理員的名字等信息，第三張表就存放管理的信息以及管理員的郵件地址。都是excel表

思路是這樣：首先在表一里找到所有備注欄不為空的賬號，然后把這些賬號拿到第二張表里去搜索，如果找到了就繼續找出它對應的管理的名字，最后吧得到的管理員的名字拿到第三張表去搜索找到它的郵件地址，同時也需要把賬號和管理員郵件記錄下來。

最后使用系統用戶發郵件給所有的管理員，正文里就列出這些要做修改的賬號的基本信息。

其實這里就有2部分，第一部分主要是excel的處理，這一塊應該不復雜，我會直接貼出代碼，這里主要說明第二部分，就是郵件的發送。

CDO.Message

想通過vbs腳本來發郵件，就需要用到CDO.Message這個對象，然后配置它的屬性，比如郵件服務器，端口，認證方式，賬號密碼等，同時也可以對郵件本身的屬性做設置，比如郵件緊急度，亂碼等。下面是代碼：

function sendEmail(strEmail_From, strEmail_To, strCC_List, strEmail_Subject, strEmail_Body)

     Set cdoMail = CreateObject("CDO.Message")  '創建CDO對象
     Set cdoConf = CreateObject("CDO.Configuration") '創建CDO配置文件對象
     cdoMail.From = strEmail_From
     cdoMail.To = strEmail_To
     cdoMail.CC = strCC_List
     cdoMail.Subject = strEmail_Subject
　　　 '郵件正文
     cdoMail.HTMLbody = strEmail_Body & "</table></body></html>"
   
     cdoConf.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2    '使用網絡上的SMTP服務器而不是本地的SMTP服務器
     'cdoConf.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "9.56.224.215"
     cdoConf.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.126.com"    'SMTP服務器地址, 可以換成其他你要用的郵箱服務器或者ip
     cdoConf.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25    '郵件服務器端口
     cdoConf.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1    '服務器認證方式
     cdoConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[e-mail]" '發件人賬號
     cdoConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "123456"    '發件人登陸郵箱密碼
     cdoConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60    '連接服務器的超時時間
     cdoConf.Fields.Update  
     Set cdoMail.Configuration = cdoConf
     
     '設置郵件的重要度和優先級
     cdoMail.Fields.Item("urn:schemas:mailheader:X-MSMail-Priority") = "High"
     cdoMail.Fields.Item("urn:schemas:mailheader:X-Priority") = 2 
     cdoMail.Fields.Item("urn:schemas:httpmail:importance") = 2 
     cdoMail.Fields.Update
     
     '發送郵件
     dim sleepSeconds     
     sleepSeconds = 5
     cdoMail.Send
     WScript.Sleep(1000 * sleepSeconds)
     
     Set cdoMail = nothing
     Set cdoConf = nothing
End function

然后就可以調用它來發郵件了

sendEmail "[e-mail]", "[e-mail]", "[e-mail]", "提示郵件", "take action"

 

下面是解析excel的代碼：

Set oExcel= CreateObject("Excel.Application")

Set oWb1 = oExcel.Workbooks.Open("E:\Bluecare\AA team\115531\US-NiS3.20150909150006Copy.csv")
Set oSheetUSNi = oWb1.Sheets("US-NiS3.20150909150006Copy")

Set oWb2 = oExcel.Workbooks.Open("E:\Bluecare\AA team\115531\IBM Monthly Report.xlsx")
Set oSheetIMR = oWb2.Sheets("Sheet1")

Set oWb3 = oExcel.Workbooks.Open("E:\Bluecare\AA team\115531\Sponsor email.xls")
Set oSheetSPO = oWb3.Sheets("Sheet1")

dim Dit1:set Dit1 = CreateObject("Scripting.Dictionary")
dim Dit2:set Dit2 = CreateObject("Scripting.Dictionary")

'輸出文件路徑
dim directory1, directory2
directory1 = "C:\\temp\\sponsor_mail_found.txt"
directory2 = "C:\\temp\\sponsor_withoutMail.txt"
directory3 = "C:\\temp\\account_withoutSponsor.txt"

'for function getExpireAcc: 第一個參數是sheetname，第二個是賬號的列號，第三個是備注列號，第四個是查詢賬號的規則（比如查詢以a開頭的賬號）
'for function getData： 第一個是sheetname，第二個是需要查找的賬號，第三個是賬號列號，第三個是管理員列號，第五個是返回值
'下面就可以調用函數執行了，執行完成后可以去輸出目錄里看最終結果
outSpoMail getData(oSheetIMR, getExpireAcc(oSheetUSNi, "C","M","acl"),"A","K",Dit1), oSheetSPO

'Get impending deactivation account list from URT response file
'@param oSheet, sheet name
'@param colAccount, the 'account' column
'@param colAcctMgrAction, the 'account manager action' column
'@param strFilter,  the string used to filter the accounts that impending deactivation, eg: "U8"
Function getExpireAcc(oSheet, colAccount, colAcctMgrAction, strFilter)
    dim row, i, varacc, varama, temp
    row=oSheet.usedRange.Rows.count
    for i=2 to row
        varacc=oSheet.cells(i,colAccount)
        varama=CStr(oSheet.cells(i,colAcctMgrAction))
        if (instr(varacc,strFilter)=1) then
            temp = temp + varacc +"&"+varama+","
        end if
    Next
    dim j,spit, tmp
    spit=split(temp,",")
    for j=0 to ubound(spit)-1
        tmp = split(spit(j),"&")
        if tmp(1) = Empty or tmp(1) = "" or IsNull(tmp(1)) then
            getExpireAcc = getExpireAcc + tmp(0) + "_"
        end if
    next
end Function

'** Get sponsor name list from IBM Monthly Report spreadsheet
'@param oSheet, sheet name
'@param sourceAcct, the accounts that impending deactivation
'@param colAcctID, the account ID column 'Network ID'
'@param colSponsorName, the sponsor name column 'Sponsor'
'@param dicAcct_SponsorName, the dictionary to store the account ID and its sponsor name
Function getData(oSheet, sourceAcct, colAcctID, colSponsorName, dicAcct_SponsorName)
    dim m,n,roww, expacc,res, out
    expacc = split(sourceAcct,"_")
    roww = oSheet.usedRange.Rows.count
    for m=2 to roww
        for n=0 to ubound(expacc)-1
            if trim((oSheet.cells(m,colAcctID))) = trim(expacc(n)) then
                if oSheetIMR.cells(m,colSponsorName) = Empty or oSheetIMR.cells(m,colSponsorName) = "" or IsNull(oSheetIMR.cells(m,colSponsorName)) then
                    out = out + expacc(n)&vbcrlf
                else
                    dicAcct_SponsorName.add expacc(n),oSheetIMR.cells(m,colSponsorName)
                end if            
            end if
        next
    next
    writeTxt directory3, out
    set getData = dicAcct_SponsorName
end Function

'Get the sponsor mail address list from 'Sponsor_email' spreadsheet and write it out
Function outSpoMail(Dict,oSheet)
    Dim DictKeys, DictItems, Counter, out1, row, k, out2, out3
    row=oSheet.usedRange.Rows.count
    DictKeys = Dict.Keys
    DictItems = Dict.Items
    For Counter = 0 To Dict.Count - 1
        for k=2 to row
            if trim(DictItems(Counter))=trim(oSheet.cells(k,"A")) then
                WScript.Echo _
                    "key: " & DictKeys(Counter) & _
                    " value: " & DictItems(Counter)
                out1 = out1 + oSheet.cells(k,"B")&vbcrlf
                Dit2.add DictKeys(Counter), oSheet.cells(k,"B")
            end if
        out2 = out2 + oSheet.cells(k,"A") + "_"
        next
    Next
    set outSpoMail = Dit2
    'writeTxt(out)
    'write the sponsor mail to directory1
    writeTxt directory1, out1
    
    For Counter = 0 To Dict.Count - 1
        if instr(out2,trim(DictItems(Counter)))>0 then
            'msgbox "exist:"+ DictItems(Counter)
        else
            'msgbox "not exist:"+ DictItems(Counter)
            out3 = out3 + DictItems(Counter)&vbcrlf
        end if
    next
    'write the sponsor name which not found in sponsor file to directory2
    writeTxt directory2, out3
End Function

'輸出文件
Function writeTxt(directory, content)
    dim fso
    set fso = CreateObject("Scripting.FileSystemObject")
    set f = fso.OpenTextFile(directory, 2, true)
    f.write(content)
    f.close
    set f = nothing
    set fso = nothing
End Function

oWb1.Close
oWb2.Close
oWb3.Close
oExcel.Quit
set oExcel=nothing
set Dit1=nothing
set Dit2=nothing

WScript.Quit(0)

 

通過這2個vbs就可以到達需求的目的的，也可以將他們放在一個vbs里使用。