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