Это не образец, а непонятно что. Просто тихий ужас:
Цитата evgenmsch@vk:
|
мне нужно просто чтобы скрипт вывел такую вот таблицу »
|
Где вывел, в чём вывел? И что Вы будете дальше делать с этим выводом?
Цитата evgenmsch@vk:
|
не придираясь к трем пунктам А Б и В. »
|
Я, конечно, могу не придираться. Мне, собственно, всё равно, как Вы будете строить мост — вдоль реки или поперёк. Но программе этого не объяснишь. Она работает по заданному алгоритму. И для неё «2+2=4». Не «3», не «5», не «около 4».
Вы уверены, что в рассылке ответственным в таблице нужен именно столбец «Ответственный»? Это же тупое дублирование информации, не несущее какого-либо особого смысла в указанном контексте?!
В моём представлении на его месте имеет смысл столбец «Автор».
Впрочем, Вам виднее. Итак —
правильный файл — «
test2.txt» (я добавил строк для тестирования):
читать дальше »
Код:
Автор Ответственный Название задачи Категория задачи Статус Срок сдачи
ermolov@fozzy.ua chigrinov@fozzy.ua Установка оборудования NCR Зарегистрирован 02.10.2014
ermolov@fozzy.ua sharashov@fozzy.ua Закупка оборудования Microsoft В работе 06.10.2014
ermolov@fozzy.ua lebtag@fozzy.ua Закупка оборудования IBM Отложен 07.10.2014
ermolov@fozzy.ua chigrinov@fozzy.ua Обучение OmniWay В работе 02.10.2014
ermolov@fozzy.ua metyaev@fozzy.ua Провести тендер Microsoft Зарегистрирован 02.10.2014
alekseev@fozzy.ua chigrinov@fozzy.ua Отправить посылки Укрпочта Принят 10.10.2014
ermolov@fozzy.ua chigrinov@fozzy.ua Установка оборудования NCR Зарегистрирован 02.10.2013
ermolov@fozzy.ua sharashov@fozzy.ua Закупка оборудования Microsoft В работе 06.10.2013
ermolov@fozzy.ua lebtag@fozzy.ua Закупка оборудования IBM Отложен 07.10.2014
ermolov@fozzy.ua chigrinov@fozzy.ua Обучение OmniWay В работе 02.10.2014
ermolov@fozzy.ua metyaev@fozzy.ua Провести тендер Microsoft Зарегистрирован 02.10.2013
alekseev@fozzy.ua chigrinov@fozzy.ua Отправить посылки Укрпочта Принят 10.10.2014
Скрипт:
читать дальше »
Код:
Option Explicit
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = 1
Const cdoSendUsingPort = 2
Const cdoBasic = 1
Const strSchema = "http://schemas.microsoft.com/cdo/configuration/"
Dim strPathToSchema
Dim strSourceFile
Dim objFSO
Dim objDictionary
Dim strEMail
Dim strHTMLBody
strPathToSchema = "E:\Песочница\0362"
strSourceFile = "test2.txt"
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strPathToSchema) Then
WScript.Echo "Folder [" & strPathToSchema & "] not found."
WScript.Quit 1
End If
If Not objFSO.FileExists(objFSO.BuildPath(strPathToSchema, strSourceFile)) Then
WScript.Echo "Source file [" & strSourceFile & "] not found."
WScript.Quit 2
End If
CreateSchema objFSO.BuildPath(strPathToSchema, "Schema.ini"), strSourceFile
Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
With WScript.CreateObject("ADODB.Recordset")
.Open _
"SELECT [Автор] " & _
"FROM [" & strSourceFile & "] " & _
"GROUP BY [Автор] " & _
"ORDER BY [Автор]", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & strPathToSchema & "';Extended Properties=""text;""", _
adOpenStatic, adLockOptimistic, adCmdText
Do Until .EOF
objDictionary.Add .Fields.Item("Автор").Value, Now()
.MoveNext
Loop
.Close
End With
For Each strEMail In objDictionary.Keys
With WScript.CreateObject("CDO.Message")
.From = "account@mail.ru"
.To = strEMail
.Subject = "Статусы задач на " & Now()
With .Configuration.Fields
.Item(strSchema & "smtpserver") = "smtp.mail.ru"
.Item(strSchema & "sendusing") = cdoSendUsingPort
.Item(strSchema & "smtpserverport") = 25
.Item(strSchema & "smtpauthenticate") = cdoBasic
.Item(strSchema & "sendusername") = "account@mail.ru"
.Item(strSchema & "sendpassword") = "password"
.Item(strSchema & "smtpconnectiontimeout") = 10
.Update
End With
.BodyPart.Charset = "windows-1251"
strHTMLBody = _
"<html>" & vbCrLf & _
" <head>" & vbCrLf & _
" <meta http-equiv='Content-Type' content='text/html; charset=windows-1251'>" & vbCrLf & _
" <title>Статусы задач на " & objDictionary.Item(strEMail) & "</title>" & vbCrLf & _
" <style>" & vbCrLf & _
" <!--" & vbCrLf & _
" p {" & vbCrLf & _
" font-family: Verdana;" & vbCrLf & _
" margin: 0.5em;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" table {" & vbCrLf & _
" font-family: Verdana;" & vbCrLf & _
" border-collapse: collapse;" & vbCrLf & _
" margin: 0.5em;" & vbCrLf & _
" padding: 0.5em;" & vbCrLf & _
" border: medium solid;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" caption {" & vbCrLf & _
" margin: 0.5em;" & vbCrLf & _
" font-weight: bold;" & vbCrLf & _
" font-size: small;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" thead {" & vbCrLf & _
" text-align: center;" & vbCrLf & _
" font-weight: bold;" & vbCrLf & _
" background-color: yellowgreen;" & vbCrLf & _
" border: medium solid;" & vbCrLf & _
" font-size: medium;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" tr {" & vbCrLf & _
" font-size: x-small;" & vbCrLf & _
" } " & vbCrLf & _
" " & vbCrLf & _
" tr.odd {" & vbCrLf & _
" background-color: beige;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" tr.even {" & vbCrLf & _
" background-color: bisque;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" tr.expired {" & vbCrLf & _
" color: maroon;" & vbCrLf & _
" background-color: coral;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" td {" & vbCrLf & _
" border: thin solid;" & vbCrLf & _
" margin: 0.5em;" & vbCrLf & _
" }" & vbCrLf & _
" -->" & vbCrLf & _
" </style>" & vbCrLf & _
" </head>" & vbCrLf & _
" <body>" & vbCrLf & _
" <p>Уважаемый сотрудник, " & strEMail & "!</p>" & vbCrLf & _
" <table>" & vbCrLf & _
" <caption>Статусы задач на " & objDictionary.Item(strEMail) & "</caption>" & vbCrLf & _
" <thead>" & vbCrLf & _
" <tr>" & vbCrLf & _
" <td>Название задачи</td>" & vbCrLf & _
" <td>Категория задачи</td>" & vbCrLf & _
" <td>Статус</td>" & vbCrLf & _
" <td>Срок сдачи</td>" & vbCrLf & _
" <td>Ответственный</td>" & vbCrLf & _
" </tr>" & vbCrLf & _
" </thead>" & vbCrLf
With WScript.CreateObject("ADODB.Recordset")
.Open _
"SELECT * " & _
"FROM [" & strSourceFile & "] " & _
"WHERE [Автор] = '" & strEMail & "'", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & strPathToSchema & "';Extended Properties=""text;""", _
adOpenStatic, adLockOptimistic, adCmdText
Do Until .EOF
If DateDiff("d", .Fields.Item("Срок сдачи").Value, objDictionary.Item(strEMail)) > 0 Then
strHTMLBody = strHTMLBody & " <tr class='expired'>" & vbCrLf
Else
If .AbsolutePosition Mod 2 = 1 Then
strHTMLBody = strHTMLBody & " <tr class='odd'>" & vbCrLf
Else
strHTMLBody = strHTMLBody & " <tr class='even'>" & vbCrLf
End If
End If
With .Fields
strHTMLBody = strHTMLBody & _
" <td>" & .Item("Название задачи").Value & "</td>" & vbCrLf & _
" <td>" & .Item("Категория задачи").Value & "</td>" & vbCrLf & _
" <td>" & .Item("Статус").Value & "</td>" & vbCrLf & _
" <td>" & .Item("Срок сдачи").Value & "</td>" & vbCrLf & _
" <td>" & .Item("Ответственный").Value & "</td>" & vbCrLf & _
" </tr>" & vbCrLf
End With
.MoveNext
Loop
.Close
End With
strHTMLBody = strHTMLBody & _
" </table>" & vbCrLf & _
" </body>" & vbCrLf & _
"</html>"
.HTMLBody = strHTMLBody
.AutoGenerateTextBody = True
.BodyPart.GetStream().SaveToFile objFSO.BuildPath(strPathToSchema, strEMail & " " & Replace(objDictionary.Item(strEMail), ":", "_") & ".eml"), 2
'.Send
End With
Next
objDictionary.RemoveAll
With WScript.CreateObject("ADODB.Recordset")
.Open _
"SELECT [Ответственный] " & _
"FROM [" & strSourceFile & "] " & _
"GROUP BY [Ответственный] " & _
"ORDER BY [Ответственный]", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & strPathToSchema & "';Extended Properties=""text;""", _
adOpenStatic, adLockOptimistic, adCmdText
Do Until .EOF
objDictionary.Add .Fields.Item("Ответственный").Value, Now()
.MoveNext
Loop
.Close
End With
For Each strEMail In objDictionary.Keys
With WScript.CreateObject("CDO.Message")
.From = "account@mail.ru"
.To = strEMail
.Subject = "Статусы задач на " & Now()
With .Configuration.Fields
.Item(strSchema & "smtpserver") = "smtp.mail.ru"
.Item(strSchema & "sendusing") = cdoSendUsingPort
.Item(strSchema & "smtpserverport") = 25
.Item(strSchema & "smtpauthenticate") = cdoBasic
.Item(strSchema & "sendusername") = "account@mail.ru"
.Item(strSchema & "sendpassword") = "password"
.Item(strSchema & "smtpconnectiontimeout") = 10
.Update
End With
.BodyPart.Charset = "windows-1251"
strHTMLBody = _
"<html>" & vbCrLf & _
" <head>" & vbCrLf & _
" <meta http-equiv='Content-Type' content='text/html; charset=windows-1251'>" & vbCrLf & _
" <title>Статусы задач на " & objDictionary.Item(strEMail) & "</title>" & vbCrLf & _
" <style>" & vbCrLf & _
" <!--" & vbCrLf & _
" p {" & vbCrLf & _
" font-family: Verdana;" & vbCrLf & _
" margin: 0.5em;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" table {" & vbCrLf & _
" font-family: Verdana;" & vbCrLf & _
" border-collapse: collapse;" & vbCrLf & _
" margin: 0.5em;" & vbCrLf & _
" padding: 0.5em;" & vbCrLf & _
" border: medium solid;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" caption {" & vbCrLf & _
" margin: 0.5em;" & vbCrLf & _
" font-weight: bold;" & vbCrLf & _
" font-size: small;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" thead {" & vbCrLf & _
" text-align: center;" & vbCrLf & _
" font-weight: bold;" & vbCrLf & _
" background-color: yellowgreen;" & vbCrLf & _
" border: medium solid;" & vbCrLf & _
" font-size: medium;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" tr {" & vbCrLf & _
" font-size: x-small;" & vbCrLf & _
" } " & vbCrLf & _
" " & vbCrLf & _
" tr.odd {" & vbCrLf & _
" background-color: beige;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" tr.even {" & vbCrLf & _
" background-color: bisque;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" tr.expired {" & vbCrLf & _
" color: maroon;" & vbCrLf & _
" background-color: coral;" & vbCrLf & _
" }" & vbCrLf & _
" " & vbCrLf & _
" td {" & vbCrLf & _
" border: thin solid;" & vbCrLf & _
" margin: 0.5em;" & vbCrLf & _
" }" & vbCrLf & _
" -->" & vbCrLf & _
" </style>" & vbCrLf & _
" </head>" & vbCrLf & _
" <body>" & vbCrLf & _
" <p>Уважаемый сотрудник, " & strEMail & "!</p>" & vbCrLf & _
" <table>" & vbCrLf & _
" <caption>Статусы задач на " & objDictionary.Item(strEMail) & "</caption>" & vbCrLf & _
" <thead>" & vbCrLf & _
" <tr>" & vbCrLf & _
" <td>Название задачи</td>" & vbCrLf & _
" <td>Категория задачи</td>" & vbCrLf & _
" <td>Статус</td>" & vbCrLf & _
" <td>Срок сдачи</td>" & vbCrLf & _
" <td>Ответственный</td>" & vbCrLf & _
" </tr>" & vbCrLf & _
" </thead>" & vbCrLf
With WScript.CreateObject("ADODB.Recordset")
.Open _
"SELECT * " & _
"FROM [" & strSourceFile & "] " & _
"WHERE [Ответственный] = '" & strEMail & "'", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & strPathToSchema & "';Extended Properties=""text;""", _
adOpenStatic, adLockOptimistic, adCmdText
Do Until .EOF
If DateDiff("d", .Fields.Item("Срок сдачи").Value, objDictionary.Item(strEMail)) > 0 Then
strHTMLBody = strHTMLBody & " <tr class='expired'>" & vbCrLf
Else
If .AbsolutePosition Mod 2 = 1 Then
strHTMLBody = strHTMLBody & " <tr class='odd'>" & vbCrLf
Else
strHTMLBody = strHTMLBody & " <tr class='even'>" & vbCrLf
End If
End If
With .Fields
strHTMLBody = strHTMLBody & _
" <td>" & .Item("Название задачи").Value & "</td>" & vbCrLf & _
" <td>" & .Item("Категория задачи").Value & "</td>" & vbCrLf & _
" <td>" & .Item("Статус").Value & "</td>" & vbCrLf & _
" <td>" & .Item("Срок сдачи").Value & "</td>" & vbCrLf & _
" <td>" & .Item("Ответственный").Value & "</td>" & vbCrLf & _
" </tr>" & vbCrLf
End With
.MoveNext
Loop
.Close
End With
strHTMLBody = strHTMLBody & _
" </table>" & vbCrLf & _
" </body>" & vbCrLf & _
"</html>"
.HTMLBody = strHTMLBody
.AutoGenerateTextBody = True
.BodyPart.GetStream().SaveToFile objFSO.BuildPath(strPathToSchema, strEMail & " " & Replace(objDictionary.Item(strEMail), ":", "_") & ".eml"), 2
'.Send
End With
Next
objDictionary.RemoveAll
Set objDictionary = Nothing
RemoveSchema objFSO.BuildPath(strPathToSchema, "Schema.ini")
Set objFSO = Nothing
WScript.Quit 0
'=============================================================================
'=============================================================================
Sub CreateSchema(strFullPathToSchemaIni, strSourceFile)
With WScript.CreateObject("Scripting.FileSystemObject")
If .FileExists(strFullPathToSchemaIni) Then
.DeleteFile strFullPathToSchemaIni, True
End If
With .CreateTextFile(strFullPathToSchemaIni, True)
.WriteLine "[" & strSourceFile & "]"
.WriteLine "ColNameHeader=True"
.WriteLine "Format=TabDelimited"
.WriteLine "TextDelimiter=none"
.WriteLine "DateTimeFormat=dd.mm.yyyy"
.WriteLine "CharacterSet=ANSI"
.Close
End With
With .GetFile(strFullPathToSchemaIni)
.Attributes = .Attributes Or 2
End With
End With
End Sub
'=============================================================================
'=============================================================================
Sub RemoveSchema(strFullPathToSchemaIni)
With WScript.CreateObject("Scripting.FileSystemObject")
If .FileExists(strFullPathToSchemaIni) Then
.DeleteFile strFullPathToSchemaIni, True
End If
End With
End Sub
'=============================================================================
В настоящее время сообщения создаются, но не отсылаются, а
сохраняются с именами+датами в формате «.eml» в указанном каталоге — Вы их можете открыть в любом почтовом клиенте:
для демонстрации полученных результатов.
Чтобы запретить сохранение сообщений в файлы закомментируйте
строки с «.BodyPart.GetStream().SaveToFile …». Для отправки сообщений раскомментируйте
строки с «.Send».
