Excel VBA: 自動生成巡檢報表並通過郵件定時發送

目錄

環境說明
邏輯結構
效果說明及截圖
①. 安裝SecureCRT
②. 自動巡檢腳本
③. 數據檢索並FTP傳送
④. 安裝Excel 2013
⑤. 安裝Serv-U
⑥. 自動生成圖表並郵件發送

環境說明

系統: Windows Server 2003, Windows Server 2008

Windows Server 2003上目錄結構: 

Windows Server 2008 上的目錄結構:

系統說明: 可在一台機器上進行[Windows Server 2008支持Excel 2013], 本文在Windows server2003上做數據采集, Windows server2008 上做報表

軟件: SecureCRT, Excel 2013, Serv-U

邏輯結構

 

效果說明及截圖

①. 安裝SecureCRT

　　安裝方法請參考官方文檔, 安裝后能夠實現通過命令行調出SecureCRT窗口

　　

②. 自動巡檢腳本

1. 建立巡檢列表device_list.txt

建立一個名為device_list.txt的文本, 其中數據組織格式為 IP地址 用戶名 密碼 enable密碼 例如 192.168.100.1 root pass enpass

2. 建立SecureCRT可調用的腳本checking_router.vbs

腳本內容如下

Sub Main
     '打開保存設備管理地址以及密碼的文件
     Const ForReading = 1, ForWriting = 2, ForAppending = 8
     Dim fso,dvices,line,command,params
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set dvices = fso.OpenTextFile("device_list",Forreading, False)        
     crt.Screen.Synchronous = True
     DO While dvices.AtEndOfStream <> True
        '讀出每行
        line = dvices.ReadLine
        '分離每行的參數 IP地址 用戶名 密碼 En密碼
        params = Split (line)
        '在日志文件里添加時間戳
        dim directory
        directory = "datadir/" & "R_"&params(0)&"_"&Year(Date)&Right("0"&Month(Date),2)&Right("0"&Day(Date),2)& ".txt"
        set fso1=createobject("scripting.filesystemobject") 
        set file=fso1.opentextfile(directory,8,true)
        dim timestamp
        timestamp = "flow: "&Year(now)&"-"&Month(now)&"-"&Day(now)&" "&Hour(now)&":"&Minute(now) 
        file.writeline timestamp
        file.close 
        '下面執行命令, 並將命令執行結果記入日志
        crt.session.LogFileName = "datadir/" & "R_"&params(0)&"_"&Year(Date)&Right("0"&Month(Date),2)&Right("0"&Day(Date),2)& ".txt"
        '表示讓日志追加寫入
        crt.session.Log true, true
        'SSH2到這個設備上
        crt.session.Connect "/SSH2 /PASSWORD "&params(2)&" "&params(1)&"@" & params(0)
        '輸入telnet密碼
        'crt.Screen.WaitForString "Password:"
        'crt.Screen.Send params(1) & chr(13)
        '進特權模式
        crt.Screen.Send "enable" & chr(13)
        crt.Screen.WaitForString "Password:"
        crt.Screen.Send params(3) & chr(13)
        crt.Screen.waitForString "#"
        '執行數據收集命令
        command = "show ip fpm statistics"
        crt.Screen.Send command & vbcr
        crt.Screen.waitForString "#" 
        '執行完命令, 斷開連接
        crt.Session.Disconnect         
        loop
    '在后台運行
    crt.Screen.Synchronous = False
    '執行完關閉程序
    Close_Process("securecrt.exe")      
End Sub
    sub Close_Process(ProcessName)  
    On Error Resume Next  
         for each ps in getobject("winmgmts:\\.\root\cimv2:win32_process").instances_ '循環進程  
               if Ucase(ps.name)=Ucase(ProcessName) then  
                     ps.terminate  
               end if  
         next  
    end sub  

3. 建立Inspection_router.bat

• 腳本內容如下
  

  @echo off
  securecrt /SCRIPT checking_router.vbs

4. 設定自動任務計划

　　　　設定Inspection_router.bat任務計划, 該計划任務設定的巡檢周期為30分鍾, 從0:10開始, 執行24個小時, 每天每台網絡設備會產生48條數據

　　　　

　　　　設定search_transfer.bat計划任務

　　　　

5. 執行結果

　　　　

③. 數據檢索並FTP傳送

• 1. 創建數據檢索腳本search_transfer.bat

@echo off

::獲取和vb一致的時間格式
set /a tm1=%time:~0,2%*1
if %tm1% LSS 10 set tm1=0%tm1%
echo %date:~0,4%%date:~5,2%%date:~8,2%
set i=%date:~0,4%%date:~5,2%%date:~8,2%


::篩選原始巡檢數據
mkdir temp
for %%I in (datadir/R_*_%i%.txt) do (echo %%I
findstr "flows" datadir\%%I>temp\%%I)

::向日志里添加分割線
echo ======================================================== >> log.txt
::向日志里添加日期時間
echo %date% %time%>> log.txt


::執行cmd.txt里的傳輸信息, 日志輸出到log.txt
ftp -s:ftpinfo.txt >> log.txt

::清除temp臨時文件夾
rd /S /Q temp

::刪除臨時文件lldp的篩選結果
for /r %%a in (*_Report_%i%*) do (del %%a)

• 2. 創建ftp信息文本ftpinfo.txt

  open 192.168.100.103
  user
  password
  
  lcd temp
  mkdir temp
  cd /temp/
  
  binary
  prompt off
  mput *.txt
  
  quit

④. 安裝Excel 2013

安裝方法參考官方文檔

⑤. 安裝Serv-U

安裝方法參考官方文檔

⑥. 自動生成圖表並郵件發送

1. 建立巡檢設備列表文件NBR_G.txt

文件內容格式為 IP地址 設備名稱 設備型號; 每個型號統計結束, 使用 IP END 型號 結束標志

例如

192.168.10.1 Waiwang 1500G
IP END 1500G
192.168.20.1 MSTP 2000G
192.168.30.1 IPsec 2000G
IP END 2000G

2. 建立報表繪圖文件NBR_G.xlsm(支持宏的Excel)

建立時間表

　　編寫宏代碼　

'Attribute VB_Name = "模塊1"
Sub 制圖表_NBR_G()
'Attribute 制圖表_NBR_G.VB_ProcData.VB_Invoke_Func = " \n14"
'獲取當前文件目錄
    Dim CurPath
    CurPath = ActiveWorkbook.Path
' 制圖表_NBR_G 宏
    Application.DisplayAlerts = False
' 獲取今天的時間
    Dim DateOfToday As String
    DateOfToday = Format$(Date, "yyyymmdd")
    'DateOfToday = 20161105
'打開文本取數據
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
'格式:路由器IP 店鋪編號 型號
    Dim fso, file1, line, params, ip, number, mode
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file1 = fso.OpenTextFile(CurPath & "\NBR_G.txt", ForReading, False)
'循環寫每一列數據
Do While file1.AtEndOfStream <> True
'讀取一行數據
    line = file1.ReadLine
'格式:路由器IP 店鋪編號 型號
    params = Split(line)
'獲取IP地址
    ip = params(0)
'店鋪編號
    number = params(1)
'獲取設備型號
    mode = params(2)
    
'判斷同一型號設備添加數據結束,制圖標
    If number = "END" Then
    '刪除掉多余字符串
    Cells.Replace What:="Number of active flows:", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Active flows num:", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    If mode = "1300G" Then
'調整數據格式
    Range("B2:AI49").Select
    Selection.NumberFormatLocal = "0"
'選擇區域生成圖表
    Range("A1:AI49").Select
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
    ActiveChart.SetSourceData Source:=Range("data!$A$1:$AI$49")
    End If
    
    If mode = "1000G" Then
'調整數據格式
    Range("B2:I49").Select
    Selection.NumberFormatLocal = "0"
'選擇區域生成圖表
    Range("A1:I49").Select
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
    ActiveChart.SetSourceData Source:=Range("data!$A$1:$I$49")
    End If
    
    If mode = "1500G" Then
    '調整數據格式
    Range("B2:B49").Select
    Selection.NumberFormatLocal = "0"
'選擇區域生成圖表
    Range("A1:B49").Select
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
    ActiveChart.SetSourceData Source:=Range("data!$A$1:$B$49")
    End If
    
    If mode = "2000G" Then
    '調整數據格式
    Range("B2:D49").Select
    Selection.NumberFormatLocal = "0"
'選擇區域生成圖表
    Range("A1:D49").Select
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
    ActiveChart.SetSourceData Source:=Range("data!$A$1:$D$49")
    End If
        
    ActiveChart.Axes(xlCategory).Select
'調整圖表橫坐標度量值
    ActiveChart.Axes(xlCategory).MaximumScale = 1
    ActiveChart.Axes(xlCategory).MajorUnit = 0.05
'調整圖表縱坐標起始值
    ActiveChart.Axes(xlValue).MinimumScale = 0
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 245
'修改圖表title
    ActiveChart.ChartTitle.Select
    Selection.Format.TextFrame2.TextRange.Characters.Text = mode & "-" & DateOfToday & "-Report"
    ActiveChart.ChartArea.Select
'移動到新的chart里
    ActiveChart.Location Where:=xlLocationAsNewSheet
    End If
    
    
    If ip <> "IP" Then
'激活data sheet
    Worksheets("data").Activate
'從文本讀取數據寫到B2
    
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & CurPath & "\temp\R_" & ip & "_" & DateOfToday & ".txt", Destination:= _
        Range("$B$2"))
        .Name = "R_" & ip & "_" & DateOfToday & ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
'將店鋪編號寫到B1
    Range("B1").Select
    ActiveCell.FormulaR1C1 = number
    End If

Loop
'將生成圖標另存為本目錄下的excel
    ChDir CurPath
    ActiveWorkbook.SaveAs Filename:=CurPath & "\NBR_G_Report_" & DateOfToday & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

3. 建立可調用NBR_G.xlsm執行的腳本NBR_G.vbs

'獲取當前目錄
Dim CurrentDirectory
CurrentDirectory =Left(WScript.ScriptFullName, (Len(WScript.ScriptFullName))-(Len(WScript.ScriptName)))
Set objExcel = CreateObject("Excel.Application")
'打開指定的含有宏的excel
Set objWorkbook = objExcel.Workbooks.Open(CurrentDirectory & "NBR_G.xlsm")
'設置excel運行是否可視
objExcel.Application.Visible = false
'objExcel.Workbooks.Add
'objExcel.Cells(1, 1).Value = "Test value"
'運行Execl中的宏
objExcel.Application.Run "制報表_NBR_G"
'關閉活動的表格
objExcel.ActiveWorkbook.Close
'關閉Execl程序
objExcel.Application.Quit
'WScript.Echo "Finished."
'退出vbs
WScript.Quit

4. 建立自動發送郵件腳本SendEmail.vbs

'以下是利用上面的函數發送帶附件的郵件例子 
If Send_Mail("[e-mail]","sendpass","reciver mail1;receiver mail2","","巡檢報告詳情請查看附件!")=True Then 
'Wscript.Echo "發送成功" 
Else 
'Wscript.Echo "發送失敗" 
End If 

function Send_mail(You_Account,You_Password,Send_Email,Send_Email2,Send_Body)  
'code by NetPatch 
'VBS發送郵件參數說明 
'You_Account：你的郵件帳號 
'You_Password:你的郵件密碼 
'Send_Email: 主要郵件地址 
'Send_Email2: 備用郵件地址 
'Send_Topic: 郵件主題 
'Send_Body:   郵件內容 
'Send_Attachment:郵件附件 

You_ID=Split(You_Account, "@", -1, vbTextCompare)  
'帳號和服務器分離 
MS_Space = "http://schemas.microsoft.com/cdo/configuration/" 
'這個是必須要的，不過可以放心的事，不會通過微軟發送郵件 
Set Email = CreateObject("CDO.Message") 
Email.From = You_Account 
'這個一定要和發送郵件的帳號一樣 
Email.To = Send_Email         '主要郵件地址 

If Send_Email2 <> "" Then 
Email.CC = Send_Email2        '備用郵件地址 
End If 

Email.Subject = "巡檢報告_"&Year(now)&"-"&Month(now)&"-"&Day(now)&" "&Hour(now)&":"&Minute(now)         '郵件主題 
Email.Textbody = Send_Body        '郵件內容 

'If IsArray(Send_Attachment) Then
'Dim attachment
'For Each attachment In Send_Attachment
'Email.AddAttachment attachment     '郵件附件 
'Next
'End If

'從dir_temp.txt讀取含有指定日期的巡檢文件,添加成附件
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso,file1,attachment
Set fso = CreateObject("Scripting.FileSystemObject")
Set file1 = fso.OpenTextFile("dir_temp.txt",Forreading, False)        
DO While file1.AtEndOfStream <> True
'讀出每行
attachment = file1.ReadLine
Email.AddAttachment attachment    
loop

'If Send_Attachment <> "" Then 
'Email.AddAttachment Send_Attachment     '郵件附件 
'End If 

With Email.Configuration.Fields 
.Item(MS_Space&"sendusing") = 2       '發信端口 
.Item(MS_Space&"smtpserver") = "smtp."&You_ID(1) 'SMTP服務器地址 
.Item(MS_Space&"smtpserverport") = 25     'SMTP服務器端口 
.Item(MS_Space&"smtpauthenticate") = 1     'cdobasec 
.Item(MS_Space&"sendusername") = You_ID(0)    '你的郵件帳號 
.Item(MS_Space&"sendpassword") = You_Password   '你的郵件密碼 
.Update 
End With 
Email.Send 
'發送郵件 
Set Email=Nothing 
'關閉組件 

Send_Mail=True  
'如果沒有任何錯誤信息，則表示發送成功,否則發送失敗  
If Err Then  
Err.Clear  
Send_Mail=False  
End If  
End Function 

5. 建立可調用NBR_G.xlsm和SendEmail.vbs的腳本NBR_G.bat

@echo off

::調用生成圖表
wscript NBR_G.vbs

::刪除臨時文件及文件夾,靜默, 不需要確認
rd /S /Q temp

::查找相關文件目錄存放到dir_temp.txt
for /r %%a in (*_Report_%i%*) do (echo %%a>>dir_temp.txt)

::郵件發送
wscript SendEmail.vbs

::刪除郵件已發送的附件存根
for /r %%a in (*_Report_%i%*) do (del %%a)
del dir_temp.txt

6. 設定自動任務計划

設定自動任務計划的對象是NBR_G.bat