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