'скрипт автоматического копирования файлов
pType = "sklad"
StartFolder = "\\sklad\PR" ' откуда копируем
EndFolder = "\\skull\Data\Install\SMB\" ' куда копируем

'***********************************************
Set StartFiles = CreateObject("Scripting.FileSystemObject")
Set WSNetwork = CreateObject("WScript.Network")
num = 0
'копируем файлы
on error resume next
dim errorString, tmpstr, mailtext
dim ErrorNumber : ErrorNumber=0
set FilesList = StartFiles.GetFolder(StartFolder).Files
For Each File in FilesList
       If LCase(StartFiles.GetExtensionName(File)) = "mdb" Then
               tmpstr = GetDateFormat(Cdate(Now()), "YMDHMS")
               tmpstr = AddToFname(File.Name, tmpstr, pType)
               StartFiles.CopyFile File, EndFolder & tmpstr, True
               num = num+1
       End If
       If Err.Number<>0 Then
               errorString = errorString & "Ошибка копирования файла: " & File & vbnewline
               ErrorNumber = ErrorNumber + 1
               Err.Clear
       end if
Next
on error goto 0

'сообщаем о результатах копирования
If ErrorNumber>0 Then
       mailtext = errorString & "Обновление SKLAD прошло с ошибками. Сообщите об этом администратору."
else
       mailtext = "Обновление файлов SKLAD прошло успешно. Скопировано " & num & " файлов."
End if

SendToSMTPRUS "mail.ru", "xxx@yyy.ru", "xxx@yyy.ru", "", "XA xa " & Now(), mailtext, ""

function GetDateFormat(NowDate, DateFormatStr)
       Dim m_Day, m_Month, m_Year, m_Hour, m_Minute, m_Second
       

       if Day(NowDate)<10 then m_Day=Cstr("0"&Day(NowDate)) else m_Day=Cstr(Day(NowDate)) end if
       if Month(NowDate)<10 then m_Month=Cstr("0"&Month(NowDate)) else m_Month=Cstr(Month(NowDate)) end if
       m_Year = cstr(Year(NowDate))
       
       if Hour(NowDate)<10 then m_Hour="0"&Hour(NowDate) else m_Hour=Hour(NowDate) end if
       if Minute(NowDate)<10 then m_Minute="0"&Minute(NowDate) else m_Minute=Minute(NowDate) end if
       if Second(NowDate)<10 then m_Second="0"&Second(NowDate) else m_Second=Second(NowDate) end if

       select case DateFormatStr
               case "YMD": GetDateFormat = m_Year&m_Month&m_Day
               case "MYD": GetDateFormat = m_Month&m_Year&m_Day
               case "DMY": GetDateFormat = m_Day&m_Month&m_Year

               case "YMDHMS": GetDateFormat = m_Year&m_Month&m_Day&m_Hour&m_Minute&m_Second
               case "MYDHMS": GetDateFormat = m_Month&m_Year&m_Day&m_Hour&m_Minute&m_Second
               case "DMYHMS": GetDateFormat = m_Day&m_Month&m_Year&m_Hour&m_Minute&m_Second

               case else : GetDateFormat = m_Year&m_Month&m_Day
       end select
End function

function AddToFname(fname, iStr, suf)
Dim regEx, mth, sReplStr
Set regEx = New RegExp

regEx.Pattern = "\.[a-zа-я]{1,}$"
regEx.IgnoreCase = true
regEx.Global = true

if regEx.Test(fname) then
       Set mth = regEx.Execute(fname)
       sReplStr = "_" & suf & "_" & iStr & mth.Item(0).value
       AddToFname = regEx.Replace(fname, sReplStr)
else
       AddToFname = fname & "_" & suf & "_"  & iStr
end if
End function

Function SendToSMTPRUS(server, FromAdr, ToAdr, CcAdr, Subject, Body, Fname)
dim SmtpRus, fso
    Set SmtpRus    = CreateObject("smtprus.smtprus.1")
    'SmtpRus.Host    = "pop3"
    SmtpRus.Host    = server
    'SmtpRus.Port = Request.Form("port")
    SmtpRus.From    = FromAdr
    SmtpRus.To        = ToAdr
    SmtpRus.Cc        = CcAdr
    'SmtpRus.Bcc    = ""
    'SmtpRus.Charset = ""
    'SmtpRus.AdditionalHeader = ""
    SmtpRus.Subject = Subject
    SmtpRus.Body    = Body
    
    if trim(Fname & "")<>"" then
        Set fso = CreateObject("Scripting.FileSystemObject")
        If fso.FileExists( trim(Fname & "") ) Then
            SmtpRus.Attach = trim(Fname & "")
        end if
        Set fso = Nothing
    end if
    
    SmtpRus.SendLetter

    SendToSMTPRUS    = SmtpRus.ErrorCode
    Set SmtpRus=Nothing
End Function