VBS自动备份文件到指定邮箱(页 1) - VBS原创&转载 - 批处理之家 BAT,CMD,批处理,PowerShell,VBS,DOS

youxi01 发表于 2009-10-18 23:13

VBS自动备份文件到指定邮箱

1、程序编写背景：前一阵子，因为误操作，导致电脑中储存的重要资料毁灭性丢失，心痛至极。吸取这次惨痛教训，决定将重要资料再网络上做一个备份。于是写了一个小程序，实现自动压缩重要资料所在文件夹，然后上传到指定的163邮箱。

2、程序功能：能够将指定文件或文件夹压缩上传至指定邮箱。支持多文件(夹)拖放：可以将要备份到邮箱的文件(夹)直接拖放到本程序图标上。

3、使用要求：电脑存在WinRAR.exe(可以是绿色版)；至少拥有一个163邮箱（用来发送邮件的邮箱最好是很早前申请的163邮箱，因为新申请的163邮箱可能不支持SMTP服务）；将代码中红色字体部分修改为自己的相关信息。

4、程序源代码：[quote]'/*/////////////////////邮箱配置//////////////////////
MailTo="[color=red]YourEmail[/color]"  '接收邮箱
UserName="[color=red]YourID[/color]" '发送邮箱
PassWord="[color=red]YourPass[/color]" '发送邮箱密码
MailC  '邮件内容
PackArr=""  '默认压缩上传文件夹位置
'/*////////////////////////////////////////////////////
MailFrom=UserName & "@163.com"
FileCount=Wscript.Arguments.Count
IF FileCount>0 then
PackArr=""
For i=0 to FileCount-1
  PackArr=PackArr & Wscript.Arguments(i) & ";"
Next
PackArr=Left(PackArr,Len(PackArr)-1)
End IF
IF PackArr="" then Wscript.quit
Set oShell=CreateObject("Wscript.Shell")
Set FSO=CreateObject("Scripting.FileSystemObject")
Function GetProgPath(ProgramName)
RegList="HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\"
RegPath=RegList & ProgramName & "\Path"
GetProgPath=oShell.RegRead(RegPath)
End Function
Sub PackUpOBJ(SourcePath,SourceOBJ,DestFileName)
IF FSO.FileExists(DestFileName) then FSO.deleteFile DestFileName,True
RarPath=chr(34) & GetProgPath("WinRAR.exe") & "\Rar" & chr(34)
CMDLine=RarPath & " a " & chr(34) & SourcePath & DestFileName & chr(34) & " " & SourceOBj
oShell.run CMDLine,VBhide
End Sub
Function Send_Mail(Subject,MailFrom,MailTo,MailContent,MailAttachment)
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = MailFrom
Email.To = MailTo
Email.Subject = Subject
Email.Textbody = MailContent
Email.AddAttachment MailAttachment
With Email.Configuration.Fields
.Item(NameSpace&"sendusing") = 2
.Item(NameSpace&"smtpserver") = "smtp.163.com"
.Item(NameSpace&"smtpserverport") = 25
.Item(NameSpace&"smtpauthenticate") = 1
.Item(NameSpace&"sendusername") = UserName
.Item(NameSpace&"sendpassword") = PassWord
.Update
End With
Email.Send
Send_Mail=True
if err then Err.Clear:Send_Mail=False
Set Email=nothing
End Function
SourceFolder=split(PackArr,";")
For i=0 to UBound(SourceFolder)
IF FSO.FileExists(SourceFolder(i)) then
  Set objFile=FSO.GetFile(SourceFolder(i))
  FileEX=FSO.GetExtensionName(SourceFolder(i))
  FileNameLen=Len(objFile.name)-Len(FileEX)-1
  DestFileName=Left(objFile.name,FileNameLen) & "(" & date & ").rar"
  FolderPath=objFile.ParentFolder & "\"
ElseIF FSO.FolderExists(SourceFolder(i)) then
  Set objFolder=FSO.getfolder(SourceFolder(i))
  DestFileName=objFolder.Name & "(" & date & ").rar"
  FolderPath=objFolder.ParentFolder & "\"
Else
  DestFileName=""
End IF
IF DestFileName<>"" then
  Call PackUpOBJ(FolderPath,SourceFolder(i),DestFileName)

  For j=1 to 51
n=n+1
IF n>=50 then wscript.quit
IF FSO.FileExists(FolderPath & DestFileName) then
wscript.sleep 500
exit for
End IF
wscript.sleep 500
  Next
  IF Send_Mail(DestFileName,MailFrom,MailTo,MailContent,FolderPath &
DestFileName)=True then
FSO.deleteFile FolderPath & DestFileName
   msgbox DestFileName & "发送成功!",vbinformation+vbokonly,"BackUp To
EMail"
  Else
msgbox DestFileName &"发送失败!",vbinformation+vbokonly,"BackUp To
EMail"
  End IF
End IF
Next

Set oShell=nothing
Set FSO=nothing[/quote]

[color=red]论坛程序会吃掉小部分代码，因此上传了附件。程序运行前，请按照前面的说明，修改程序内容。[/color]
[color=#ff0000][/color]

zjw767676 发表于 2009-10-19 09:45

红色字体怎么不见？
是否是：
YourEmail
YourID
YourPass
PackArr="" （引号里要写路径吗？）
不懂VBS，请赐教！！！

dengx 发表于 2009-10-19 10:08

能用bat写一次吗 ?

youxi01 发表于 2009-10-19 10:49

回复 2楼的帖子

理解正确！

zjw767676 发表于 2009-10-19 11:51

拖动文件

youxi01 发表于 2009-10-19 12:13

回复 5楼的帖子

论坛程序“吃”掉了部分代码...

已经上传附件。下载好附件解压后，运行前，请先修改程序代码。

zjw767676 发表于 2009-10-19 18:08

[code]MailTo="zjw767676@163.com" '接收邮箱
UserName="zjw767676" '发送邮箱
PassWord="*******" '发送邮箱密码
MailContent="资料备份!" '邮件内容

PackArr="d:\a" '默认压缩上传文件夹位置[/code]运行后能把文件夹压缩，但不能发送

youxi01 发表于 2009-10-19 22:39

回复 7楼的帖子

你的这个邮箱应该“资历”较浅，就是新申请的，163新申请的邮箱不支持SMTP的

发送邮箱一定要一个能够支持SMTP的，而且程序代码只支持163邮箱，如果确有需要，可以修改相应代码或联系本人修改。

zjw767676 发表于 2009-10-19 23:27

回复 8楼的帖子

我的邮箱是2008年5月申请的，不知道算新还是算旧？
如能出个P版的也能学习学习，期待中。。。。。

wps999 发表于 2010-4-12 17:17

我点了却没有反映。。。

youxi01 发表于 2010-12-11 23:45

回复 13楼的帖子

出现这个问题的原因是，当程序发送附件的时候，压缩还没完成
你可以把里面延时部分的值改的大一些

ooaf 发表于 2011-1-9 18:50

楼主，请问如何把一个文件夹里的文件用附件发出去？不是压缩成一个文件。
因为文件个数不确定，一直想不到方法，请指教。

当然前提是每个文件的大小都符合附件的大小要求。

poon 发表于 2011-5-20 22:23

好好学习一下！！！

poon 发表于 2011-5-20 22:47

试试，成功了！

vbscxf 发表于 2012-2-19 19:02

真的很好~~！

vbscxf 发表于 2012-2-19 19:03

不过现在已经有这么多的网络同步盘可用，貌似这个小程序就基本无用武之地了。

breakme 发表于 2012-2-19 19:37

我有发送邮件的 bat 版本也就是vbs 的和autoit的，要的联系QQ:49849628

tmp05 发表于 2020-5-30 23:21

感觉好复杂，能否简要解释下

页: [1]

批处理之家's Archiver