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

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

时间：2021-07-13 07:36:38

环境说明

系统: Windows Server , Windows Server

Windows Server 上目录结构:

Windows Server 上的目录结构:

系统说明: 可在一台机器上进行[Windows Server 支持Excel ], 本文在Windows server上做数据采集, Windows server 上做报表

软件: SecureCRT, Excel , 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'打开保存设备管理地址以及密码的文件 3Const ForReading = 1, ForWriting = 2, ForAppending = 8 4Dim fso,dvices,line,command,params 5Set fso = CreateObject("Scripting.FileSystemObject") 6Set dvices = fso.OpenTextFile("device_list",Forreading, False) 7crt.Screen.Synchronous = True 8DO While dvices.AtEndOfStream <> True 9 '读出每行10 line = dvices.ReadLine11 '分离每行的参数 IP地址用户名密码 En密码12 params = Split (line)13 '在日志文件里添加时间戳14 dim directory15 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 timestamp19 timestamp = "flow: "&Year(now)&"-"&Month(now)&"-"&Day(now)&" "&Hour(now)&":"&Minute(now) 20 file.writeline timestamp21 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, true26 '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 & vbcr39 crt.Screen.waitForString "#" 40 '执行完命令, 断开连接41 crt.Session.Disconnect 42 loop43'在后台运行44crt.Screen.Synchronous = False45'执行完关闭程序46Close_Process("securecrt.exe")47 End Sub48sub Close_Process(ProcessName) 49On Error Resume Next 50for each ps in getobject("winmgmts:\\.\root\cimv2:win32_process").instances_ '循环进程 51if Ucase(ps.name)=Ucase(ProcessName) then 52 ps.terminate 53end if 54next 55end sub

checking_router.bat

3. 建立Inspection_router.bat

脚本内容如下

@echo offsecurecrt /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 temp12 for %%I in (datadir/R_*_%i%.txt) do (echo %%I13 findstr "flows" datadir\%%I>temp\%%I)14 15 ::向日志里添加分割线16 echo ======================================================== >> log.txt17 ::向日志里添加日期时间18 echo %date% %time%>> log.txt19 20 21 ::执行cmd.txt里的传输信息, 日志输出到log.txt22 ftp -s:ftpinfo.txt >> log.txt23 24 ::清除temp临时文件夹25 rd /S /Q temp26 27 ::删除临时文件lldp的筛选结果28 for /r %%a in (*_Report_%i%*) do (del %%a)

search_transter.bat

2. 创建ftp信息文本ftpinfo.txt

open 192.168.100.103userpasswordlcd tempmkdir tempcd /temp/binaryprompt offmput *.txtquit

④. 安装Excel

安装方法参考官方文档

⑤. 安装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 '获取当前文件目录 5Dim CurPath 6CurPath = ActiveWorkbook.Path 7 ' 制图表_NBR_G 宏 8Application.DisplayAlerts = False 9 ' 获取今天的时间 10Dim DateOfToday As String 11DateOfToday = Format$(Date, "yyyymmdd") 12'DateOfToday = 1105 13 '打开文本取数据 14Const ForReading = 1, ForWriting = 2, ForAppending = 8 15 '格式:路由器IP 店铺编号型号 16Dim fso, file1, line, params, ip, number, mode 17Set fso = CreateObject("Scripting.FileSystemObject") 18Set file1 = fso.OpenTextFile(CurPath & "\NBR_G.txt", ForReading, False) 19 '循环写每一列数据 20 Do While file1.AtEndOfStream <> True 21 '读取一行数据 22line = file1.ReadLine 23 '格式:路由器IP 店铺编号型号 24params = Split(line) 25 '获取IP地址 26ip = params(0) 27 '店铺编号 28number = params(1) 29 '获取设备型号 30mode = params(2) 3132 '判断同一型号设备添加数据结束,制图标 33If number = "END" Then 34'删除掉多余字符串 35Cells.Replace What:="Number of active flows:", Replacement:="", LookAt:= _ 36 xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 37 ReplaceFormat:=False 38Cells.Replace What:="Active flows num:", Replacement:="", LookAt:= _ 39 xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 40 ReplaceFormat:=False 4142If mode = "1300G" Then 43 '调整数据格式 44Range("B2:AI49").Select 45Selection.NumberFormatLocal = "0" 46 '选择区域生成图表 47Range("A1:AI49").Select 48ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select 49ActiveChart.SetSourceData Source:=Range("data!$A$1:$AI$49") 50End If 5152If mode = "1000G" Then 53 '调整数据格式 54Range("B2:I49").Select 55Selection.NumberFormatLocal = "0" 56 '选择区域生成图表 57Range("A1:I49").Select 58ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select 59ActiveChart.SetSourceData Source:=Range("data!$A$1:$I$49") 60End If 6162If mode = "1500G" Then 63'调整数据格式 64Range("B2:B49").Select 65Selection.NumberFormatLocal = "0" 66 '选择区域生成图表 67Range("A1:B49").Select 68ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select 69ActiveChart.SetSourceData Source:=Range("data!$A$1:$B$49") 70End If 7172If mode = "2000G" Then 73'调整数据格式 74Range("B2:D49").Select 75Selection.NumberFormatLocal = "0" 76 '选择区域生成图表 77Range("A1:D49").Select 78ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select 79ActiveChart.SetSourceData Source:=Range("data!$A$1:$D$49") 80End If 8182ActiveChart.Axes(xlCategory).Select 83 '调整图表横坐标度量值 84ActiveChart.Axes(xlCategory).MaximumScale = 1 85ActiveChart.Axes(xlCategory).MajorUnit = 0.05 86 '调整图表纵坐标起始值 87ActiveChart.Axes(xlValue).MinimumScale = 0 88ActiveChart.ClearToMatchStyle 89ActiveChart.ChartStyle = 245 90 '修改图表title 91ActiveChart.ChartTitle.Select 92Selection.Format.TextFrame2.TextRange.Characters.Text = mode & "-" & DateOfToday & "-Report" 93ActiveChart.ChartArea.Select 94 '移动到新的chart里 95ActiveChart.Location Where:=xlLocationAsNewSheet 96End If 979899If ip <> "IP" Then100 '激活data sheet101Worksheets("data").Activate102 '从文本读取数据写到B2103104With ActiveSheet.QueryTables.Add(Connection:= _105 "TEXT;" & CurPath & "\temp\R_" & ip & "_" & DateOfToday & ".txt", Destination:= _106 Range("$B$2"))107 .Name = "R_" & ip & "_" & DateOfToday & ""108 .FieldNames = True109 .RowNumbers = False110 .FillAdjacentFormulas = False111 .PreserveFormatting = True112 .RefreshOnFileOpen = False113 .RefreshStyle = xlInsertDeleteCells114 .SavePassword = False115 .SaveData = True116 .AdjustColumnWidth = False117 .RefreshPeriod = 0118 .TextFilePromptOnRefresh = False119 .TextFilePlatform = 936120 .TextFileStartRow = 1121 .TextFileParseType = xlDelimited122 .TextFileTextQualifier = xlTextQualifierDoubleQuote123 .TextFileConsecutiveDelimiter = False124 .TextFileTabDelimiter = True125 .TextFileSemicolonDelimiter = False126 .TextFileCommaDelimiter = False127 .TextFileSpaceDelimiter = False128 .TextFileColumnDataTypes = Array(1, 1, 1, 1)129 .TextFileTrailingMinusNumbers = True130 .Refresh BackgroundQuery:=False131End With132 '将店铺编号写到B1133Range("B1").Select134ActiveCell.FormulaR1C1 = number135End If136 137 Loop138 '将生成图标另存为本目录下的excel139ChDir CurPath140ActiveWorkbook.SaveAs Filename:=CurPath & "\NBR_G_Report_" & DateOfToday & ".xlsx", _141 FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False142 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.Add10 'objExcel.Cells(1, 1).Value = "Test value"11 '运行Execl中的宏12 objExcel.Application.Run "制报表_NBR_G"13 '关闭活动的表格14 objExcel.ActiveWorkbook.Close15 '关闭Execl程序16 objExcel.Application.Quit17 'WScript.Echo "Finished."18 '退出vbs19 WScript.Quit

NBR_G.vbs

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

1 '以下是利用上面的函数发送带附件的邮件例子 2 If Send_Mail("senduser@","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 = "/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 = 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) Then36 'Dim attachment37 'For Each attachment In Send_Attachment38 'Email.AddAttachment attachment'邮件附件 39 'Next40 'End If41 42 '从dir_temp.txt读取含有指定日期的巡检文件,添加成附件43 Const ForReading = 1, ForWriting = 2, ForAppending = 844 Dim fso,file1,attachment45 Set fso = CreateObject("Scripting.FileSystemObject")46 Set file1 = fso.OpenTextFile("dir_temp.txt",Forreading, False) 47 DO While file1.AtEndOfStream <> True48 '读出每行49 attachment = file1.ReadLine50 Email.AddAttachment attachment 51 loop52 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.txt10 for /r %%a in (*_Report_%i%*) do (echo %%a>>dir_temp.txt)11 12 ::邮件发送13 wscript SendEmail.vbs14 15 ::删除邮件已发送的附件存根16 for /r %%a in (*_Report_%i%*) do (del %%a)17 del dir_temp.txt

NBR_G.bat

6. 设定自动任务计划

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

本内容不代表本网观点和政治立场，如有侵犯你的权益请联系我们处理。

网友评论

网友评论仅供其表达个人看法，并不表明网站立场。