Sub SendFile(File, Subj)		
  '---------------------------------
  'http://forum.sysadmins.su/index.php?showtopic=111&st=0&p=2728
  '-----------------------------------------
  'On Error Resume Next
  '------------------------------------------------------------------
  Dim objMsg
  Dim Config
  Set objMsg = CreateObject("CDO.Message")
  Set Config = CreateObject("CDO.Configuration")
  Set Config = objMsg.Configuration
  ' Set the sendusing field to '....'.
      Config("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
      Config("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
      Config("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
      Config("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
      'Config("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
      Config("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = "box@domain.com"
      Config("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
      Config("http://schemas.microsoft.com/cdo/configuration/sendusername") = "box@domain.com"
      Config("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pass"
      Config("http://schemas.microsoft.com/cdo/configuration/languagecode") = "ru"
      
  ' Update the fields.
  Config.Fields.Update
  With objMsg
     .To   = "box@domain.com"
     .From = "box@domain.com"
     .Subject  = Subj
     .TextBody = ""
     .AddAttachment File
     ' ..
  End With
  objMsg.Send
  'Wscript.Echo "Отправка завершена"
  'Wscript.Quit

  Set objMsg = Nothing
  Set Config = Nothing

End Sub

set objShell = CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")

for each f in objFSO.GetFolder("G:\Base\!backup").Files

	Extension = lcase(objFSO.getextensionname(f))

	if Extension = "dt" then

    dateOfFile = Left(f.Name, Len(f.Name) - 3)

    archive = "G:\Base\!backup\" & dateOfFile & ".rar"

    objShell.Run Chr(34) & "c:\program files\winrar\rar.exe" & Chr(34) & " u -v24500k -m0 -dh -os -ow -hp[пароль без квадратных скобок] " & archive & " G:\Base\!backup\" & f.Name, True, True
  
	end if
 
next

for each f in objFSO.GetFolder("G:\Base\!backup").Files

	Extension = lcase(objFSO.getextensionname(f))

	if Extension = "rar" then

		dateOfFile  = Left(f.Name, 10)
		dateReverse = Right(dateOfFile, 2) & "." & Mid(dateOfFile, 6, 2) & "." & Left(dateOfFile, 4)

		if Len(f.Name) > 14 then
			part = Mid(f.Name, 12, 5)
			subj = "Наша контора " & dateReverse & " [" & part & "]" 
		else
			subj = "Наша контора " & dateReverse
		end if 

		SendFile "G:\Base\!backup\" & f.Name, subj

		objFSO.DeleteFile("G:\Base\!backup\" & f.Name)

	end if

next