发个WINDOWS下用Email附件备份数据VBS脚本 - 全球主机交流论坛

'-----------------------------------------------------------------------------------
'应用程序配置项↓
'-----------------------------------------------------------------------------------
'数据库目录 (目录均以"" 结尾)
Const MySqlDataDir = "C:\Users\Neta\Desktop\Data"
'备份数据库目录
Const MySqlBackupDir = "C:\Users\Neta\Desktop"
'RAR压缩程序文件路径
Const RarExePath = "rar.exe"
'发件邮箱
Const EmailFrom = "[email protected]"
'收件邮箱推荐网易邮箱
Const EmailTo = "[email protected]"
'SMTP地址
Const SmtpServer = "smtp.qq.com"
'SMTP端口
Const SmtpServerPort = 25
'SMTP发信登陆帐号
Const SendUserName = "[email protected]"
'SMTP发信登陆密码
Const SendPassWord = "password"
'发送完毕是否删除备份数据文件 true | false
Const DeleteFile = true
'单个附件大小单位为MB
Const AttachmentSize = 30
'---------------------------------------------------------------------------------------
'其他说明: 当执行RAR压缩的时候会出现一个命令行窗口显示压缩过程请勿关闭!
'---------------------------------------------------------------------------------------
backupDateTime = now()
backupFileName = GetName(backupDateTime)
attach = MySqlBackupDir & backupFileName & ".rar"
'开始备份
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
WshShell.run RarExePath & " a -ibck " & attach & " " & MySqlDataDir,,true
Set backupFile = fso.GetFile(attach)
'判断附件大小如果超过AttachmentSize 则进行分卷打包
IF backupFile.Size > AttachmentSize * 1024 * 1024 Then
'计算分卷打包文件个数
TotalFile = GetInteger(backupFile.Size / (AttachmentSize * 1024 * 1024))
'重新取得文件打包时间
backupDateTime = now()
backupFileName = GetName(backupDateTime)
'开始分卷打包
WshShell.run RarExePath & " a -v" & AttachmentSize & "m -ibck " & MySqlBackupDir & backupFileName & " " & attach,,true
'删除初次打包的文件
Call DelFile(attach)
'发送分卷
For P = 1 To TotalFile
attach = MySqlBackupDir & backupFileName & ".part" & P & ".rar"
Call SendMail(attach,backupDateTime)
Next
Else
Call SendMail(attach,backupDateTime)
End IF
Set WshShell = Nothing
Set fso = Nothing
Function GetName(time)
GetName = Replace(Replace(Replace(time, "/", "-"), " ", "-"), ":", "-")
End Function
Function GetInteger(number)
GetInteger = int(number)
IF GetInteger < number Then
GetInteger = GetInteger + 1
End IF
End Function
Sub DelFile(path)
IF deleteFile Then
fso.DeleteFile(path)
End IF
End Sub
Sub SendMail(file,time)
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
set Email = CreateObject("CDO.Message")
Email.From = EmailFrom
Email.To = EmailTo
Email.Subject = "MYSQL BACKUP : " & time
Email.Textbody = "这个是数据库备份文件,备份于: " & time
Email.AddAttachment file
With Email.Configuration.Fields
.Item(NameSpace&"sendusing") = 2
.Item(NameSpace&"smtpserver") = SmtpServer
.Item(NameSpace&"smtpserverport") = SmtpServerPort
.Item(NameSpace&"smtpauthenticate") = 1
.Item(NameSpace&"sendusername") = SendUserName
.Item(NameSpace&"sendpassword") = SendPassWord
.Update
End With
Email.Send
Set Email = Nothing
Call DelFile(file)
End Sub

复制代码