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

时间:2024-03-07 08:55:31

目录

环境说明
逻辑结构
效果说明及截图
①. 安装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

脚本内容如下

 1 Sub Main
 2      \'打开保存设备管理地址以及密码的文件
 3      Const ForReading = 1, ForWriting = 2, ForAppending = 8
 4      Dim fso,dvices,line,command,params
 5      Set fso = CreateObject("Scripting.FileSystemObject")
 6      Set dvices = fso.OpenTextFile("device_list",Forreading, False)        
 7      crt.Screen.Synchronous = True
 8      DO While dvices.AtEndOfStream <> True
 9         \'读出每行
10         line = dvices.ReadLine
11         \'分离每行的参数 IP地址 用户名 密码 En密码
12         params = Split (line)
13         \'在日志文件里添加时间戳
14         dim directory
15         directory = "datadir/" & "R_"&params(0)&"_"&Year(Date)&Right("0"&Month(Date),2)&Right("0"&Day(Date),2)& ".txt"
16         set fso1=createobject("scripting.filesystemobject") 
17         set file=fso1.opentextfile(directory,8,true)
18         dim timestamp
19         timestamp = "flow: "&Year(now)&"-"&Month(now)&"-"&Day(now)&" "&Hour(now)&":"&Minute(now) 
20         file.writeline timestamp
21         file.close 
22         \'下面执行命令, 并将命令执行结果记入日志
23         crt.session.LogFileName = "datadir/" & "R_"&params(0)&"_"&Year(Date)&Right("0"&Month(Date),2)&Right("0"&Day(Date),2)& ".txt"
24         \'表示让日志追加写入
25         crt.session.Log true, true
26         \'SSH2到这个设备上
27         crt.session.Connect "/SSH2 /PASSWORD "&params(2)&" "&params(1)&"@" & params(0)
28         \'输入telnet密码
29         \'crt.Screen.WaitForString "Password:"
30         \'crt.Screen.Send params(1) & chr(13)
31         \'进特权模式
32         crt.Screen.Send "enable" & chr(13)
33         crt.Screen.WaitForString "Password:"
34         crt.Screen.Send params(3) & chr(13)
35         crt.Screen.waitForString "#"
36         \'执行数据收集命令
37         command = "show ip fpm statistics"
38         crt.Screen.Send command & vbcr
39         crt.Screen.waitForString "#" 
40         \'执行完命令, 断开连接
41         crt.Session.Disconnect         
42         loop
43     \'在后台运行
44     crt.Screen.Synchronous = False
45     \'执行完关闭程序
46     Close_Process("securecrt.exe")      
47 End Sub
48     sub Close_Process(ProcessName)  
49     On Error Resume Next  
50          for each ps in getobject("winmgmts:\\.\root\cimv2:win32_process").instances_ \'循环进程  
51                if Ucase(ps.name)=Ucase(ProcessName) then  
52                      ps.terminate  
53                end if  
54          next  
55     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

 1 @echo off
 2 
 3 ::获取和vb一致的时间格式
 4 set /a tm1=%time:~0,2%*1
 5 if %tm1% LSS 10 set tm1=0%tm1%
 6 echo %date:~0,4%%date:~5,2%%date:~8,2%
 7 set i=%date:~0,4%%date:~5,2%%date:~8,2%
 8 
 9 
10 ::筛选原始巡检数据
11 mkdir temp
12 for %%I in (datadir/R_*_%i%.txt) do (echo %%I
13 findstr "flows" datadir\%%I>temp\%%I)
14 
15 ::向日志里添加分割线
16 echo ======================================================== >> log.txt
17 ::向日志里添加日期时间
18 echo %date% %time%>> log.txt
19 
20 
21 ::执行cmd.txt里的传输信息, 日志输出到log.txt
22 ftp -s:ftpinfo.txt >> log.txt
23 
24 ::清除temp临时文件夹
25 rd /S /Q temp
26 
27 ::删除临时文件lldp的筛选结果
28 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)

建立时间表

  编写宏代码 

  1 \'Attribute VB_Name = "模块1"
  2 Sub 制图表_NBR_G()
  3 \'Attribute 制图表_NBR_G.VB_ProcData.VB_Invoke_Func = " \n14"
  4 \'获取当前文件目录
  5     Dim CurPath
  6     CurPath = ActiveWorkbook.Path
  7 \' 制图表_NBR_G 宏
  8     Application.DisplayAlerts = False
  9 \' 获取今天的时间
 10     Dim DateOfToday As String
 11     DateOfToday = Format$(Date, "yyyymmdd")
 12     \'DateOfToday = 20161105
 13 \'打开文本取数据
 14     Const ForReading = 1, ForWriting = 2, ForAppending = 8
 15 \'格式:路由器IP 店铺编号 型号
 16     Dim fso, file1, line, params, ip, number, mode
 17     Set fso = CreateObject("Scripting.FileSystemObject")
 18     Set file1 = fso.OpenTextFile(CurPath & "\NBR_G.txt", ForReading, False)
 19 \'循环写每一列数据
 20 Do While file1.AtEndOfStream <> True
 21 \'读取一行数据
 22     line = file1.ReadLine
 23 \'格式:路由器IP 店铺编号 型号
 24     params = Split(line)
 25 \'获取IP地址
 26     ip = params(0)
 27 \'店铺编号
 28     number = params(1)
 29 \'获取设备型号
 30     mode = params(2)
 31     
 32 \'判断同一型号设备添加数据结束,制图标
 33     If number = "END" Then
 34     \'删除掉多余字符串
 35     Cells.Replace What:="Number of active flows:", Replacement:="", LookAt:= _
 36         xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
 37         ReplaceFormat:=False
 38     Cells.Replace What:="Active flows num:", Replacement:="", LookAt:= _
 39         xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
 40         ReplaceFormat:=False
 41         
 42     If mode = "1300G" Then
 43 \'调整数据格式
 44     Range("B2:AI49").Select
 45     Selection.NumberFormatLocal = "0"
 46 \'选择区域生成图表
 47     Range("A1:AI49").Select
 48     ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
 49     ActiveChart.SetSourceData Source:=Range("data!$A$1:$AI$49")
 50     End If
 51     
 52     If mode = "1000G" Then
 53 \'调整数据格式
 54     Range("B2:I49").Select
 55     Selection.NumberFormatLocal = "0"
 56 \'选择区域生成图表
 57     Range("A1:I49").Select
 58     ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
 59     ActiveChart.SetSourceData Source:=Range("data!$A$1:$I$49")
 60     End If
 61     
 62     If mode = "1500G" Then
 63     \'调整数据格式
 64     Range("B2:B49").Select
 65     Selection.NumberFormatLocal = "0"
 66 \'选择区域生成图表
 67     Range("A1:B49").Select
 68     ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
 69     ActiveChart.SetSourceData Source:=Range("data!$A$1:$B$49")
 70     End If
 71     
 72     If mode = "2000G" Then
 73     \'调整数据格式
 74     Range("B2:D49").Select
 75     Selection.NumberFormatLocal = "0"
 76 \'选择区域生成图表
 77     Range("A1:D49").Select
 78     ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
 79     ActiveChart.SetSourceData Source:=Range("data!$A$1:$D$49")
 80     End If
 81         
 82     ActiveChart.Axes(xlCategory).Select
 83 \'调整图表横坐标度量值
 84     ActiveChart.Axes(xlCategory).MaximumScale = 1
 85     ActiveChart.Axes(xlCategory).MajorUnit = 0.05
 86 \'调整图表纵坐标起始值
 87     ActiveChart.Axes(xlValue).MinimumScale = 0
 88     ActiveChart.ClearToMatchStyle
 89     ActiveChart.ChartStyle = 245
 90 \'修改图表title
 91     ActiveChart.ChartTitle.Select
 92     Selection.Format.TextFrame2.TextRange.Characters.Text = mode & "-" & DateOfToday & "-Report"
 93     ActiveChart.ChartArea.Select
 94 \'移动到新的chart里
 95     ActiveChart.Location Where:=xlLocationAsNewSheet
 96     End If
 97     
 98     
 99     If ip <> "IP" Then
100 \'激活data sheet
101     Worksheets("data").Activate
102 \'从文本读取数据写到B2
103     
104     With ActiveSheet.QueryTables.Add(Connection:= _
105         "TEXT;" & CurPath & "\temp\R_" & ip & "_" & DateOfToday & ".txt", Destination:= _
106         Range("$B$2"))
107         .Name = "R_" & ip & "_" & DateOfToday & ""
108         .FieldNames = True
109         .RowNumbers = False
110         .FillAdjacentFormulas = False
111         .PreserveFormatting = True
112         .RefreshOnFileOpen = False
113         .RefreshStyle = xlInsertDeleteCells
114         .SavePassword = False
115         .SaveData = True
116         .AdjustColumnWidth = False
117         .RefreshPeriod = 0
118         .TextFilePromptOnRefresh = False
119         .TextFilePlatform = 936
120         .TextFileStartRow = 1
121         .TextFileParseType = xlDelimited
122         .TextFileTextQualifier = xlTextQualifierDoubleQuote
123         .TextFileConsecutiveDelimiter = False
124         .TextFileTabDelimiter = True
125         .TextFileSemicolonDelimiter = False
126         .TextFileCommaDelimiter = False
127         .TextFileSpaceDelimiter = False
128         .TextFileColumnDataTypes = Array(1, 1, 1, 1)
129         .TextFileTrailingMinusNumbers = True
130         .Refresh BackgroundQuery:=False
131     End With
132 \'将店铺编号写到B1
133     Range("B1").Select
134     ActiveCell.FormulaR1C1 = number
135     End If
136 
137 Loop
138 \'将生成图标另存为本目录下的excel
139     ChDir CurPath
140     ActiveWorkbook.SaveAs Filename:=CurPath & "\NBR_G_Report_" & DateOfToday & ".xlsx", _
141         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
142 
143 End Sub
制报表_NBR_G

3. 建立可调用NBR_G.xlsm执行的脚本NBR_G.vbs

 1 \'获取当前目录
 2 Dim CurrentDirectory
 3 CurrentDirectory =Left(WScript.ScriptFullName, (Len(WScript.ScriptFullName))-(Len(WScript.ScriptName)))
 4 Set objExcel = CreateObject("Excel.Application")
 5 \'打开指定的含有宏的excel
 6 Set objWorkbook = objExcel.Workbooks.Open(CurrentDirectory & "NBR_G.xlsm")
 7 \'设置excel运行是否可视
 8 objExcel.Application.Visible = false
 9 \'objExcel.Workbooks.Add
10 \'objExcel.Cells(1, 1).Value = "Test value"
11 \'运行Execl中的宏
12 objExcel.Application.Run "制报表_NBR_G"
13 \'关闭活动的表格
14 objExcel.ActiveWorkbook.Close
15 \'关闭Execl程序
16 objExcel.Application.Quit
17 \'WScript.Echo "Finished."
18 \'退出vbs
19 WScript.Quit
NBR_G.vbs

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

 1 \'以下是利用上面的函数发送带附件的邮件例子 
 2 If Send_Mail("senduser@163.com","sendpass","reciver mail1;receiver mail2","","巡检报告详情请查看附件!")=True Then 
 3 \'Wscript.Echo "发送成功" 
 4 Else 
 5 \'Wscript.Echo "发送失败" 
 6 End If 
 7 
 8 function Send_mail(You_Account,You_Password,Send_Email,Send_Email2,Send_Body)  
 9 \'code by NetPatch 
10 \'VBS发送邮件参数说明 
11 \'You_Account:你的邮件帐号 
12 \'You_Password:你的邮件密码 
13 \'Send_Email: 主要邮件地址 
14 \'Send_Email2: 备用邮件地址 
15 \'Send_Topic: 邮件主题 
16 \'Send_Body:   邮件内容 
17 \'Send_Attachment:邮件附件 
18 
19 You_ID=Split(You_Account, "@", -1, vbTextCompare)  
20 \'帐号和服务器分离 
21 MS_Space = "http://schemas.microsoft.com/cdo/configuration/" 
22 \'这个是必须要的,不过可以放心的事,不会通过微软发送邮件 
23 Set Email = CreateObject("CDO.Message") 
24 Email.From = You_Account 
25 \'这个一定要和发送邮件的帐号一样 
26 Email.To = Send_Email         \'主要邮件地址 
27 
28 If Send_Email2 <> "" Then 
29 Email.CC = Send_Email2        \'备用邮件地址 
30 End If 
31 
32 Email.Subject = "巡检报告_"&Year(now)&"-"&Month(now)&"-"&Day(now)&" "&Hour(now)&":"&Minute(now)         \'邮件主题 
33 Email.Textbody = Send_Body        \'邮件内容 
34 
35 \'If IsArray(Send_Attachment) Then
36 \'Dim attachment
37 \'For Each attachment In Send_Attachment
38 \'Email.AddAttachment attachment     \'邮件附件 
39 \'Next
40 \'End If
41 
42 \'从dir_temp.txt读取含有指定日期的巡检文件,添加成附件
43 Const ForReading = 1, ForWriting = 2, ForAppending = 8
44 Dim fso,file1,attachment
45 Set fso = CreateObject("Scripting.FileSystemObject")
46 Set file1 = fso.OpenTextFile("dir_temp.txt",Forreading, False)        
47 DO While file1.AtEndOfStream <> True
48 \'读出每行
49 attachment = file1.ReadLine
50 Email.AddAttachment attachment    
51 loop
52 
53 \'If Send_Attachment <> "" Then 
54 \'Email.AddAttachment Send_Attachment     \'邮件附件 
55 \'End If 
56 
57 With Email.Configuration.Fields 
58 .Item(MS_Space&"sendusing") = 2       \'发信端口 
59 .Item(MS_Space&"smtpserver") = "smtp."&You_ID(1) \'SMTP服务器地址 
60 .Item(MS_Space&"smtpserverport") = 25     \'SMTP服务器端口 
61 .Item(MS_Space&"smtpauthenticate") = 1     \'cdobasec 
62 .Item(MS_Space&"sendusername") = You_ID(0)    \'你的邮件帐号 
63 .Item(MS_Space&"sendpassword") = You_Password   \'你的邮件密码 
64 .Update 
65 End With 
66 Email.Send 
67 \'发送邮件 
68 Set Email=Nothing 
69 \'关闭组件 
70 
71 Send_Mail=True  
72 \'如果没有任何错误信息,则表示发送成功,否则发送失败  
73 If Err Then  
74 Err.Clear  
75 Send_Mail=False  
76 End If  
77 End Function 
SendEmail.vbs

5. 建立可调用NBR_G.xlsm和SendEmail.vbs的脚本NBR_G.bat

 1 @echo off
 2 
 3 ::调用生成图表
 4 wscript NBR_G.vbs
 5 
 6 ::删除临时文件及文件夹,静默, 不需要确认
 7 rd /S /Q temp
 8 
 9 ::查找相关文件目录存放到dir_temp.txt
10 for /r %%a in (*_Report_%i%*) do (echo %%a>>dir_temp.txt)
11 
12 ::邮件发送
13 wscript SendEmail.vbs
14 
15 ::删除邮件已发送的附件存根
16 for /r %%a in (*_Report_%i%*) do (del %%a)
17 del dir_temp.txt
NBR_G.bat

6. 设定自动任务计划

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