Эта прога предназначена для массовой рассылки похожих писем через публичный сервер типа Mail.ru. Эта прога требуется в том случае, если порты аутентификации SMTP закрыты и прямая рассылка невозможна.
На вход проги поступают несколько шаблонов, указываемых ей в качестве входных параметров проги. Прога формирует итоговый BAT-Файл, с вызываемыми WSH-скриптами - именно такая схема рассылки на практике оказалась удобнее, чем пакетные задания в WSF-файле, ибо именно так удобнее сделать Terminate Job или Schedule job.
00001: Option Strict Off 00002: Module Module1 00003: 00004: Sub Main() 00005: Dim BodyTemplate As String = ReadMyFile("BodyTemplate") 00006: Dim WshTemplate As String = ReadMyFile("WshTemplate") 00007: Dim Mail As String, ScriptName As String, MultiLineWsh As String, BodyWithSendkey As String, k As Integer, www As String 00008: Dim XLS As New Microsoft.Office.Interop.Excel.Application 00009: XLS.Workbooks.Open(My.MySettings.Default.Item("XLS")) 00010: FileOpen(2, My.MySettings.Default.Item("OUTFilePath").ToString & "Packet.bat", OpenMode.Output, OpenAccess.Write, OpenShare.LockWrite) 00011: Dim i As Integer, j As Integer = 0 00012: For i = 1 To 1000 00013: If XLS.Cells(i, 1).value = "" Then 00014: j += 1 00015: Else 00016: 'взяли мыло и www из XLS-файла 00017: www = XLS.Cells(i, My.MySettings.Default.Item("wwwColumn")).value 00018: Mail = XLS.Cells(i, My.MySettings.Default.Item("MailColumn")).value 00019: ScriptName = My.MySettings.Default.Item("OUTFilePath").ToString & Replace(www, ".", "_") & ".wsf" 00020: Print(2, "cscript """ & ScriptName & """" & vbCrLf) 00021: ' 00022: FileOpen(1, ScriptName, OpenMode.Output, OpenAccess.Write, OpenShare.LockWrite) 00023: 'вставили мыло в скрипт 00024: MultiLineWsh = "" 00025: MultiLineWsh = Replace(WshTemplate, "XXX", Mail) 00026: 'обработка строк тела письма 00027: Dim A() As String = BodyTemplate.Split(vbCrLf) 00028: BodyWithSendkey = "" 00029: For k = 0 To A.Length - 1 00030: If InStr(A(k), "XXX") > 0 Then 00031: 'если эта строка тела содержит XXX, то сюда надо вставить В ДРУГОМ регистре название,определенное в файле Excel 00032: BodyWithSendkey &= "WshShell.SendKeys """ & Replace(Replace(A(k), "XXX", ""), vbLf, "") & """" & vbCrLf 00033: 'текст из Excela вставляем ТОЛЬКО в конец строки 00034: BodyWithSendkey &= "WshShell.SendKeys ""^+""" & vbCrLf 00035: BodyWithSendkey &= "WshShell.SendKeys """ & www & """" & vbCrLf 00036: BodyWithSendkey &= "WshShell.SendKeys ""^+""" & vbCrLf 00037: BodyWithSendkey &= "WshShell.SendKeys ""~""" & vbCrLf 00038: Else 00039: BodyWithSendkey &= "WshShell.SendKeys """ & Replace(A(k), vbLf, "") & """" & vbCrLf 00040: End If 00041: Next 00042: Print(1, Replace(MultiLineWsh, "YYY", BodyWithSendkey)) 00043: FileClose(1) 00044: End If 00045: If j > 10 Then Exit For 00046: Next 00047: XLS.Workbooks.Close() 00048: XLS.Quit() 00049: XLS = Nothing 00050: FileClose(2) 00051: End Sub 00052: 00053: Private Function ReadMyFile(ByVal SetingName As String) As String 00054: FileOpen(1, My.MySettings.Default.Item(SetingName), OpenMode.Input, OpenAccess.Read, OpenShare.Shared) 00055: While Not EOF(1) 00056: ReadMyFile &= LineInput(1) & vbCrLf 00057: End While 00058: FileClose(1) 00059: End Function 00060: 00061: End Module
Comments (
)
<00>
<01>
<02>
<03>
<04>
<05>
<06>
<07>
<08>
<09>
<10>
<11>
<12>
<13>
<14>
<15>
<16>
<17>
<18>
<19>
<20>
<21>
<22>
<23>
Link to this page:
//www.vb-net.com/wanted/message/spam.htm
<SITEMAP> <MVC> <ASP> <NET> <DATA> <KIOSK> <FLEX> <SQL> <NOTES> <LINUX> <MONO> <FREEWARE> <DOCS> <ENG> <CHAT ME> <ABOUT ME> < THANKS ME> |