'/*/////////////////////邮箱配置//////////////////////
MailTo="YourEmail"  '接收邮箱
UserName="YourID"   '发送邮箱
PassWord="YourPass"   '发送邮箱密码
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