Excel VBA: 自动生成巡检报表并通过邮件定时发送

环境说明

系统: 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 = , ForWriting = , ForAppending =

      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()&"_"&Year(Date)&Right(""&Month(Date),)&Right(""&Day(Date),)& ".txt"

         set fso1=createobject("scripting.filesystemobject")

         set file=fso1.opentextfile(directory,,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()&"_"&Year(Date)&Right(""&Month(Date),)&Right(""&Day(Date),)& ".txt"

         '表示让日志追加写入

         crt.session.Log true, true

         'SSH2到这个设备上

         crt.session.Connect "/SSH2 /PASSWORD "&params()&" "&params()&"@" & params()

         '输入telnet密码

         'crt.Screen.WaitForString "Password:"

         'crt.Screen.Send params(1) & chr(13)

         '进特权模式

         crt.Screen.Send "enable" & chr()

         crt.Screen.WaitForString "Password:"

         crt.Screen.Send params() & chr()

         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

checking_router.bat

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)

search_transter.bat

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 = , ForWriting = , ForAppending =

 '格式:路由器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()

 '店铺编号

     number = params()

 '获取设备型号

     mode = params()

 '判断同一型号设备添加数据结束,制图标

     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 = ""

 '选择区域生成图表

     Range("A1:AI49").Select

     ActiveSheet.Shapes.AddChart2(, xlXYScatterSmoothNoMarkers).Select

     ActiveChart.SetSourceData Source:=Range("data!$A$1:$AI$49")

     End If

     If mode = "1000G" Then

 '调整数据格式

     Range("B2:I49").Select

     Selection.NumberFormatLocal = ""

 '选择区域生成图表

     Range("A1:I49").Select

     ActiveSheet.Shapes.AddChart2(, xlXYScatterSmoothNoMarkers).Select

     ActiveChart.SetSourceData Source:=Range("data!$A$1:$I$49")

     End If

     If mode = "1500G" Then

     '调整数据格式

     Range("B2:B49").Select

     Selection.NumberFormatLocal = ""

 '选择区域生成图表

     Range("A1:B49").Select

     ActiveSheet.Shapes.AddChart2(, xlXYScatterSmoothNoMarkers).Select

     ActiveChart.SetSourceData Source:=Range("data!$A$1:$B$49")

     End If

     If mode = "2000G" Then

     '调整数据格式

     Range("B2:D49").Select

     Selection.NumberFormatLocal = ""

 '选择区域生成图表

     Range("A1:D49").Select

     ActiveSheet.Shapes.AddChart2(, xlXYScatterSmoothNoMarkers).Select

     ActiveChart.SetSourceData Source:=Range("data!$A$1:$D$49")

     End If

     ActiveChart.Axes(xlCategory).Select

 '调整图表横坐标度量值

     ActiveChart.Axes(xlCategory).MaximumScale =

     ActiveChart.Axes(xlCategory).MajorUnit = 0.05

 '调整图表纵坐标起始值

     ActiveChart.Axes(xlValue).MinimumScale =

     ActiveChart.ClearToMatchStyle

     ActiveChart.ChartStyle =

 '修改图表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 =

         .TextFilePromptOnRefresh = False

         .TextFilePlatform =

         .TextFileStartRow =

         .TextFileParseType = xlDelimited

         .TextFileTextQualifier = xlTextQualifierDoubleQuote

         .TextFileConsecutiveDelimiter = False

         .TextFileTabDelimiter = True

         .TextFileSemicolonDelimiter = False

         .TextFileCommaDelimiter = False

         .TextFileSpaceDelimiter = False

         .TextFileColumnDataTypes = Array(, , , )

         .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

制报表_NBR_G

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

NBR_G.vbs

4. 建立自动发送邮件脚本SendEmail.vbs

 '以下是利用上面的函数发送带附件的邮件例子

 If Send_Mail("senduser@163.com","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, "@", -, 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 = , ForWriting = , ForAppending =

 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") =        '发信端口

 .Item(MS_Space&"smtpserver") = "smtp."&You_ID() 'SMTP服务器地址

 .Item(MS_Space&"smtpserverport") =      'SMTP服务器端口

 .Item(MS_Space&"smtpauthenticate") =      'cdobasec

 .Item(MS_Space&"sendusername") = You_ID()    '你的邮件帐号

 .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

SendEmail.vbs

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

NBR_G.bat

6. 设定自动任务计划

设定自动任务计划的对象是NBR_G.bat