[решено] Как прикрепить несколько файлов в письме?

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)

- - [решено] Как прикрепить несколько файлов в письме? (http://forum.oszone.net/showthread.php?t=207261)

staw2ros

20-05-2011 17:12 1679705

Как прикрепить несколько файлов в письме?

К сожалению не очень опытен c VBS.

Есть скрипт для отправки сообщения с одним вложенным файлом!

Код:

 

Set S = CreateObject("Wscript.Shell") 

 set FSO=createobject("scripting.filesystemobject") 

 Call SendPost("smtp.mail.ru","login1@mail.ru","login2@mail.ru","Отчет","Последний месяц") 

 Function SendPost(strSMTP_Server,strTo,strFrom,strSubject,strBody) 

 Set iMsg=CreateObject("CDO.Message") 

 Set iConf=CreateObject("CDO.Configuration") 

 Set Flds=iConf.Fields 

 Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2 

 Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")=1 

 Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusername")="login" 

 Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")="password" 

 Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.mail.ru" 

 Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25 

 Flds.Update 

 iMsg.Configuration=iConf 

 iMsg.To=strTo 

 iMsg.From=strFrom 

 iMsg.Subject=strSubject 

 iMsg.TextBody=strBody 

 iMsg.AddAttachment "C:\Users\%userprofile%\Desktop\otchet_15_05_2011.txt" 

 iMsg.Send 

 End Function 

 Set iMsg=Nothing 

 Set iConf=Nothing 

 Set Flds=Nothing

1. Как отправить сразу несколько текстовых файлов?
2. Что делать если имеется несколько компьютеров..и у них разные пути к рабочему столу?

amel27

20-05-2011 17:36 1679722

1. как вариант - выполнить несколько раз "iMsg.AddAttachment"
2.

Код:

WScript.Echo WScript.CreateObject("WScript.Shell").SpecialFolders("Desktop")

staw2ros

20-05-2011 18:05 1679742

Цитата:

Цитата amel27

1. как вариант - выполнить несколько раз "iMsg.AddAttachment" »

Хм..а если количество и названия файлов произвольные?

amel27

20-05-2011 18:25 1679753

staw2ros, цикл по массиву

Iska	20-05-2011 19:01 1679767

Цитата:

Цитата staw2ros

Хм..а если количество и названия файлов произвольные? »

Передавайте скрипту пути к ним аргументами. Если не укладываетесь в ограничения длины пути — то посредством указанного аргументом текстового файла, содержащего пути к прикрепляемым файлам.

staw2ros

20-05-2011 19:08 1679768

И как это можно реализовать с данным скриптом?)

Iska	20-05-2011 22:50 1679869

Цитата:

Цитата staw2ros

И как это можно реализовать с данным скриптом? »

Сие может выглядеть, например, так:

Цитата:

Цитата Iska

Передавайте скрипту пути к ним аргументами. »

Код:

Option Explicit



Const cdoSendUsingPort = 2

Const cdoBasic         = 1



Const strPartSchema    = "http://schemas.microsoft.com/cdo/configuration/"





Dim objFSO

Dim strArg





Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")



If WScript.Arguments.Count <> 0 Then

        With WScript.CreateObject("CDO.Message")

                With .Configuration.Fields

                        .Item(strPartSchema & "sendusing")        = cdoSendUsingPort

                        .Item(strPartSchema & "smtpauthenticate") = cdoBasic

                        .Item(strPartSchema & "smtpserver")       = "smtp.mail.ru"

                        .Item(strPartSchema & "smtpserverport")   = 25

                        .Item(strPartSchema & "sendusername")     = "login"

                        .Item(strPartSchema & "sendpassword")     = "password"

                        

                        .Update

                End With

                

                .To            = "to@mail.com"

                .From          = "from@mail.com"

                .Subject       = "Subject"

                .TextBody      = "TextBody"

                

                For Each strArg In WScript.Arguments

                        If objFSO.FileExists(strArg) Then

                                .AddAttachment strArg

                        Else

                                WScript.Echo "Can't find file [" & strArg & "]"

                                WScript.Quit 2

                        End If

                Next

                

                .Send

        End With

Else

        WScript.Echo "Usage: " & WScript.ScriptName & " <file1> [<file2>] … [<fileN>]"

        WScript.Quit 1

End If



Set objFSO = Nothing



WScript.Quit 0

Пример вызова скрипта:

Код:

script.vbs "E:\Песочница\0039\Copy-Script.ps1" "E:\Песочница\0039\file_versions.ps1" "E:\Песочница\0054\0003.cmd"

Цитата:

Цитата Iska

…посредством указанного аргументом текстового файла, содержащего пути к прикрепляемым файлам. »

Код:

Option Explicit



Const ForReading = 1



Const cdoSendUsingPort = 2

Const cdoBasic         = 1



Const strPartSchema    = "http://schemas.microsoft.com/cdo/configuration/"





Dim objFSO

Dim strFile4Files

Dim strFile





Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")



If WScript.Arguments.Count = 1 Then

        strFile4Files = WScript.Arguments.Item(1)

        

        If objFSO.FileExists(strFile4Files) Then

                With WScript.CreateObject("CDO.Message")

                        With .Configuration.Fields

                                .Item(strPartSchema & "sendusing")        = cdoSendUsingPort

                                .Item(strPartSchema & "smtpauthenticate") = cdoBasic

                                .Item(strPartSchema & "smtpserver")       = "smtp.mail.ru"

                                .Item(strPartSchema & "smtpserverport")   = 25

                                .Item(strPartSchema & "sendusername")     = "login"

                                .Item(strPartSchema & "sendpassword")     = "password"

                                

                                .Update

                        End With

                        

                        .To            = "to@mail.com"

                        .From          = "from@mail.com"

                        .Subject       = "Subject"

                        .TextBody      = "TextBody"

                        

                        Set objTS = objFSO.OpenTextFile(strFile4Files, ForReading)

                        

                        Do Until objTS.AtEndOfStream

                                strFile = objTS.ReadLine()

                                

                                If objFSO.FileExists(strFile) Then

                                        .AddAttachment strFile

                                Else

                                        WScript.Echo "Can't find file [" & strFile & "]"

                                        WScript.Quit 2

                                End If

                        Loop

                        

                        objTS.Close

                        

                        Set objTS = Nothing

                        

                        .Send

                End With

        Else

                WScript.Echo "Can't find file [" & strFile4Files & "]"

        End If

Else

        WScript.Echo "Usage: " & WScript.ScriptName & " <file with paths>"

        WScript.Quit 1

End If



Set objFSO = Nothing



WScript.Quit 0

Пример вызова скрипта:

Код:

script.vbs "E:\Песочница\0055\FileList.txt"

Пример содержимого файла «E:\Песочница\0055\FileList.txt»:

Код:

E:\Песочница\0039\Copy-Script.ps1

E:\Песочница\0039\file_versions.ps1

E:\Песочница\0054\0003.cmd

staw2ros

21-05-2011 18:26 1680226

Iska, Спасибо!

Но проблему удалось решить чуть иначе...вот может кому-нибудь пригодится!

Код:

Const Desktop = 4

Set S = CreateObject("Wscript.Shell") 

Set FSO = CreateObject("scripting.filesystemobject")



strSMTP_Server = "smtp.mail.ru"

strTo = "login2@mail.ru"

strFrom = "login@mail.ru"

strSubject = "Отчет"

strBody = "Последний месяц"



Set iMsg=CreateObject("CDO.Message") 

Set iConf=CreateObject("CDO.Configuration") 

Set Flds=iConf.Fields 

Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2 

Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")=1 

Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusername")="login" 

Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")="password" 

Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.mail.ru" 

Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25 

Flds.Update 

iMsg.Configuration=iConf 

iMsg.To=strTo 

iMsg.From=strFrom 

iMsg.Subject=strSubject 

iMsg.TextBody=strBody 

Set fld = FSO.GetFolder(S.SpecialFolders(Desktop))

For each file in fld.files

    if LCase(FSO.GetExtensionName(file)) = "txt" Then

        iMsg.AddAttachment file.path 

    End if

Next

iMsg.Send

Iska	21-05-2011 19:31 1680244

staw2ros, тогда уж не:

Цитата:

Цитата staw2ros

…удалось решить…»

а «мне сделали» ;) — я видел этот код.

Цитата:

Цитата staw2ros

проблему удалось решить…»

Проблемы могут возникать позже, если вдруг на рабочем столе появятся «лишние» текстовые файлы.

staw2ros

21-05-2011 19:52 1680247

Цитата:

Цитата Iska

а «мне сделали» — я видел этот код. »

Это да! На авторство я не претендую=)

kolumb 8034

21-02-2013 19:21 2096152

Как на примере

этого

Реализовать все тоже самое только что бы информацию брало не с рабочего стола а с C:\test все файлы что есть в нутри этой папки не зависимо от имени файлов и расширений

Iska	21-02-2013 19:45 2096173

Например, так:

Код:

Option Explicit



Const cdoSendUsingPort = 2

Const cdoBasic         = 1



Const strPartSchema    = "http://schemas.microsoft.com/cdo/configuration/"





Dim objFSO

Dim objFile

Dim strFolder





Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")



strFolder = "C:\test"



If objFSO.FolderExists(strFolder) Then

        If objFSO.GetFolder(strFolder).Files.Count > 0 Then

                With WScript.CreateObject("CDO.Message")

                        With .Configuration.Fields

                                .Item(strPartSchema & "sendusing")        = cdoSendUsingPort

                                .Item(strPartSchema & "smtpauthenticate") = cdoBasic

                                .Item(strPartSchema & "smtpserver")       = "smtp.mail.ru"

                                .Item(strPartSchema & "smtpserverport")   = 25

                                .Item(strPartSchema & "sendusername")     = "login"

                                .Item(strPartSchema & "sendpassword")     = "password"

                                

                                .Update

                        End With

                        

                        .To            = "login2@mail.ru"

                        .From          = "login@mail.ru"

                        .Subject       = "Отчет"

                        .TextBody      = "Последний месяц"

                        

                        For Each objFile In objFSO.GetFolder(strFolder).Files

                                .AddAttachment objFile.Path

                        Next

                        

                        .Send

                End With

        Else

                WScript.Echo "Folder [" & strFolder & "] not contain any files"

                WScript.Quit 2

        End If

Else

        WScript.Echo "Folder [" & strFolder & "] not found"

        WScript.Quit 1

End If



Set objFSO = Nothing



WScript.Quit 0

kolumb 8034

21-02-2013 20:14 2096204

Не хотит выдает ошибку !

Iska	21-02-2013 20:21 2096215

Поправил выше. Пробуйте.

kolumb 8034

21-02-2013 21:08 2096250

Теперь другая ошибка

SMTP рабочий 100% на примере первого скрипта работает четко !

Iska	21-02-2013 22:51 2096320

kolumb 8034, наиболее вероятная причина — Ваше письмо было сочтено спамом или содержащим подозрительные файлы. Я легко добился аналогичного ответа, поместив в папку обычный пакетный файл, скрипт vbs и hta. В то же время попытка отправки простых текстовых файлов, документов Word и Excel не вызвала у SMTP-сервера Mail.RU ни малейших возражений, и письма были доставлены по адресу.

Следом: у Яndex'а нашлась инструкция по поведению — Почтовый сервер получателя принимает письма за спам, в том числе и для Mail.RU.

kolumb 8034

22-02-2013 10:54 2096528

Спасибо действительно блокирует антивирус почты ! Подскажите тогда как можно прописать какие именно расширения брать с папки ?

Iska	22-02-2013 15:22 2096735

Какие Вам, например, нужны?

kolumb 8034

24-02-2013 16:08 2097902

txt, js, vbs

Iska	24-02-2013 17:37 2097962

kolumb 8034, есть ненулевая вероятность — как мы уже видели — что данное письмо будет банально «отфутболено» или «завёрнуто» вобрат. Рациональный вариант — помещать потребные файлы в архив под паролем с обязательным шифрованием оглавления («имён файлов»), дабы содержимое архива было неизвестно. Пароль можно произвольно генерировать из ASCII и просто вкладывать в тело письма. Можно пользовать 7-zip или WinRAR.

Как смотрите на такой вариант?

kolumb 8034

24-02-2013 19:02 2098029

Как вариант можно потестить с почтой вариант такой если в папке присутствует js,vbs.txt,dll письмо не приходит если js,vbs.txt то все норм в моем случаи проблема именно и за dll !!!

Еще если можно подскажите как этот код прописать с BAT в VBS

Код:

@echo off

:start

ping 127.0.0.1 -n 15 >nul

if %errorlevel%==0 (goto send) else (goto end)



:end

goto :start



:send

Iska	24-02-2013 21:21 2098133

Цитата:

Цитата kolumb 8034

А в моём случае — нет.

Так что — делаем? И, если — «Да», то с каким архиватором из указанных.

Цитата:

Цитата kolumb 8034

Еще если можно подскажите как этот код прописать с BAT в VBS »

А какое отношение данный вопрос имеет к данной теме? Заведите под него отдельную тему — ответим.

kolumb 8034

24-02-2013 21:52 2098157

WinRAR

Iska	25-02-2013 01:44 2098309

Примерно так:

Код:

Option Explicit



Const cdoSendUsingPort = 2

Const cdoBasic         = 1



Const strPartSchema    = "http://schemas.microsoft.com/cdo/configuration/"





Dim objFSO

Dim strFolder

Dim strTempName

Dim strPassword



Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")



strFolder = "C:\test"



If objFSO.FolderExists(strFolder) Then

        If objFSO.GetFolder(strFolder).Files.Count > 0 Then

                With WScript.CreateObject("CDO.Message")

                        With .Configuration.Fields

                                .Item(strPartSchema & "sendusing")        = cdoSendUsingPort

                                .Item(strPartSchema & "smtpauthenticate") = cdoBasic

                                .Item(strPartSchema & "smtpserver")       = "smtp.mail.ru"

                                .Item(strPartSchema & "smtpserverport")   = 25

                                .Item(strPartSchema & "sendusername")     = "login"

                                .Item(strPartSchema & "sendpassword")     = "password"

                                

                                .Update

                        End With

                        

                        .To            = "login2@mail.ru"

                        .From          = "login@mail.ru"

                        .Subject       = "Отчет"

                        

                        strPassword = objFSO.GetTempName()

                        

                        .TextBody      = "Последний месяц" & vbCrLf & vbCrLf & "Password: " & strPassword

                        

                        strTempName = GetTemporaryName()

                        

                        WScript.CreateObject("WScript.Shell").Run """%ProgramFiles%\7-Zip\7z.exe"" a -t7z -p" & strPassword & " -mhe """ & strTempName & """ """ & strFolder & "\*""", 1, True

                        

                        .AddAttachment strTempName

                        

                        .Send

                End With

                

                objFSO.DeleteFile strTempName, True

        Else

                WScript.Echo "Folder [" & strFolder & "] not contain any files"

                WScript.Quit 2

        End If

Else

        WScript.Echo "Folder [" & strFolder & "] not found"

        WScript.Quit 1

End If



Set objFSO = Nothing



WScript.Quit 0

'=============================================================================



'=============================================================================

' Серый форум / vbscript: генерация пути для временного файла или папки

' (http://forum.script-coding.com/viewtopic.php?id=1221)

'=============================================================================

Function GetTemporaryName()

        Const TemporaryFolder = 2

        

        Dim strTempName

        

        With WScript.CreateObject("Scripting.FileSystemObject")

                Do

                        strTempName = .BuildPath(.GetSpecialFolder(TemporaryFolder), .GetTempName)

                Loop While .FileExists(strTempName) Or .FolderExists(strTempName)

        End With

        

        GetTemporaryName = strTempName

End Function

'=============================================================================

Время: 04:55.