[решено] Помогите доделать скрипт, который отправляет по почте текст

[streamrider]

Добрый вечер друзья помогите пожалуйста разобраться . Я написал при помощи разных ресурсов скрипт который отправляет по почте текст.

Const EmailFrom = "test@mail.ru"
Const EmailPassword = "testtest1"
Const strSmtpServer = "smtp.mail.ru"
Const EmailTo = "mains1@mail.ru"
Set objEmail = CreateObject("CDO.Message")

objEmail.From = EmailFrom
objEmail.To = EmailTo
objEmail.Subject = "test mail"
objEmail.Textbody = "134678990685445779436653754"
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailFrom
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = EmailPassword
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update

objEmail.Send

Так вот приходиться текст постоянно менять в поле objEmail.Textbody что бы получить новое сообщение . Вопрос в том как сделать что бы появлялось окно какое нибудь для ввода ? Как это будет выглядить кто нибудь может показать ? Заранее спасибо

[Iska]

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

Const ForReading = 1

Const cdoSendUsingPort = 2
Const cdoBasic = 1

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

Dim strValue


strValue = InputBox("Input mail body:", "Mail body", "Input text here…")

If Len(strValue) <> 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") = "test@mail.ru"
.Item(strPartSchema & "sendpassword") = "testtest1"

.Update
End With

.To = "mains1@mail.ru"
.From = "test@mail.ru"
.Subject = "test mail"
.TextBody = strValue

.Send
End With
Else
' Nothing to do
End If

WScript.Quit 0

[Iska]

Или, для многострочного письма, так:
Option Explicit

Const ForReading = 1

Const cdoSendUsingPort = 2
Const cdoBasic = 1

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

Dim i
Dim strLine
Dim strValue


i = 0
strValue = ""

Do
i = i + 1
strLine = InputBox("Введите [" & CStr(i) & "] строку тела письма " & _
"(введите пустую строку для окончания)", "Формирование тела письма", "Введите [" & CStr(i) & "] строку здесь…")

If Len(strLine) <> 0 Then
strValue = strValue & vbCrLf & strLine
Else
strValue = Mid(strValue, 3)

Exit Do
End If
Loop

If Len(strValue) <> 0 Then
If MsgBox("Вы сформировали следующее тело письма:" & vbCrLf & vbCrLf & _
strValue & vbCrLf & vbCrLf & _
"Отправить письмо?", vbOKCancel, "Отправка письма") = vbOK 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") = "test@mail.ru"
.Item(strPartSchema & "sendpassword") = "testtest1"

.Update
End With

.To = "mains1@mail.ru"
.From = "test@mail.ru"
.Subject = "test mail"
.TextBody = strValue

.Send
End With
End If
Else
' Nothing to do
End If

WScript.Quit 0
Если этого недостаточно/неудобно, существует иной способ — создание тела письма посредством формы на *.hta.

[streamrider]

Iska, Огромное спасибо !!! )))) +

[irshat]

Уважаемый Iska, ваш скрипт отлично работает, но нельзя ли там сделать так, чтоб сообщение с окошка отправлялось не с письмом, а виде вложения с названием темы, например: test.txt

[Iska]

…но нельзя ли там сделать…»
Конечно, можно. Делайте.

[irshat]

да я бы сделал, да скриптами вот только три дня, как начал заниматься, да что-то не доходит, форум просмотрел ничего похожего не нашел, как ветеран может подскажете :)

[Iska]

Option Explicit

Const ForReading = 1

Const cdoSendUsingPort = 2
Const cdoBasic = 1

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

Dim i
Dim strLine
Dim strValue
Dim strFile


i = 0
strValue = ""

Do
i = i + 1
strLine = InputBox("Введите [" & CStr(i) & "] строку тела письма " & _
"(введите пустую строку для окончания)", "Формирование тела письма", "Введите [" & CStr(i) & "] строку здесь…")

If Len(strLine) <> 0 Then
strValue = strValue & vbCrLf & strLine
Else
strValue = Mid(strValue, 3)

Exit Do
End If
Loop

If Len(strValue) <> 0 Then
If MsgBox("Вы сформировали следующее тело письма:" & vbCrLf & vbCrLf & _
strValue & vbCrLf & vbCrLf & _
"Отправить письмо?", vbOKCancel, "Отправка письма") = vbOK Then

strFile = GetTemporaryName()

With WScript.CreateObject("Scripting.FileSystemObject").CreateTextFile(strFile)
.Write strValue
.Close
End With

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") = "test@mail.ru"
.Item(strPartSchema & "sendpassword") = "testtest1"

.Update
End With

.To = "mains1@mail.ru"
.From = "test@mail.ru"
.Subject = "test mail"
'.TextBody = strValue

.AddAttachment strFile

.Send
End With

WScript.CreateObject("Scripting.FileSystemObject").DeleteFile strFile
End If
Else
' Nothing to do
End If

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
'=============================================================================
Не проверялось.