Помогите подружить скрипт с кирилицей

[Odarchuk]

Знатоки, есть скрипт (.vbs) который проверяет наличие новых юзверей и если такие имеються отсылает им на мыло письмо с определенным текстом.
В этом тексте вся загвоздка. ТОчнее в его кодировке. Текс на русском/украинском языке.


Подскажите чего нужно подправить чтобы все было ОК ?



ВОт сам скрипт

'Created by Mike Ruman 8/13/05
'Sends an email to accounts created today.

Dim StrDate, CurrentUTC

'Create the current date and time stamp for query for day before last
CurrentUTC = DatePart("yyyy", Date)
'now add Month in mm if only M add leading 0
if DatePart("m" , Now) < 10 then
CurrentUTC = CurrentUTC & 0 & DatePart("m" , Now)
else
CurrentUTC = CurrentUTC & DatePart("m" , Now)
end if
'now add Day in dd if only d add leading 0
if DatePart("d" , Now) < 10 then
'OPTIONAL - FOR MANY DAYS, replace line below with CurrentUTC = CurrentUTC & 0 & DatePart("d" , Now - X) where X = # of days

CurrentUTC = CurrentUTC & 0 & DatePart("d" , Now)
else
'OPTIONAL - FOR MANY DAYS, replace line below with CurrentUTC = CurrentUTC & DatePart("d" , Now - X) where X = # of days
CurrentUTC = CurrentUTC & DatePart("d" , Now)
end if
' Tag hour, minute, second on
strDate = CurrentUTC&"000001.0Z"

'Create AD Connection
Set oConnection1 = CreateObject("ADODB.Connection")
Set oCommand1 = CreateObject("ADODB.Command")
oConnection1.Provider = "ADsDSOObject" ' This is the ADSI OLE-DB provider name
oConnection1.Open "Active Directory Provider"
' Create a command object for this connection.
Set oCommand1.ActiveConnection = oConnection1
'Set Query definition
' тут задаем доменные параметры берем из AD
oCommand1.CommandText = "select mail from 'LDAP://DC=it, DC=local' WHERE objectCategory='Person' AND objectClass='user'AND msExchHideFromAddressLists<>'True' AND whenCreated>='" & strDate & "'"

oCommand1.Properties("Page Size") = 30000
' Execute the query.
Set rs = oCommand1.Execute


rs.movefirst
'Create the loop of results
Do Until rs.EOF = True


'Create Email
' настройки письма для пользователя
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "Admin@mycantora.ua"
objEmail.To = rs.Fields("mail")
'Optional BCC field
'objEmail.BCC = "Admin@mycantora.ua"
objEmail.Subject = "A welcome message from Exchange"
objEmail.HTMLbody = "Добро пожаловать в ........."

objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/languagecode") = 1049
'objMessage.BodyPart.CharSet = "windows-1251".
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/usemessageresponsetext") = true


'Optional Add an attachment
'objEmail.AddAttachment "C:\new_hire_audio_message.wav"

objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing ") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver ") = _
"ExchangeServer" 'Replace ExchangeServer with server IP or name
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport ") = 25
objEmail.Configuration.Fields.Update

'Optional - Read the message before it's sent
'MsgBox objEmail.GetStream.ReadText
objEmail.Send
rs.movenext
Loop

'Close AD Connection
oConnection1.close

[amel27]

предлагаю прежде чем постить поработать немного над проблемой самим:

- составить минимально простой скрипт, воспроизводящий проблему (увы, разбирать весь текст не досуг);
- описать подробно работу скрипта - т.е. как есть по факту и как должно быть.

[Odarchuk]

amel27, к сожелению я не силен в програмировании :(
Скрипт писал не я.
А на форум обратился за помощью только в одном вопросе - помочь с кодировкой!

[amel27]

Скрипт писал не я »это не причина, использовать то Вам... попробуйте так:'Created by Mike Ruman 8/13/05
'Sends an email to accounts created today.

Dim StrDate, CurrentUTC

'Create the current date and time stamp for query for day before last
CurrentUTC = DatePart("yyyy", Date)
'now add Month in mm if only M add leading 0
if DatePart("m" , Now) < 10 then
CurrentUTC = CurrentUTC & 0 & DatePart("m" , Now)
else
CurrentUTC = CurrentUTC & DatePart("m" , Now)
end if
'now add Day in dd if only d add leading 0
if DatePart("d" , Now) < 10 then
'OPTIONAL - FOR MANY DAYS, replace line below with CurrentUTC = CurrentUTC & 0 & DatePart("d" , Now - X) where X = # of days

CurrentUTC = CurrentUTC & 0 & DatePart("d" , Now)
else
'OPTIONAL - FOR MANY DAYS, replace line below with CurrentUTC = CurrentUTC & DatePart("d" , Now - X) where X = # of days
CurrentUTC = CurrentUTC & DatePart("d" , Now)
end if
' Tag hour, minute, second on
strDate = CurrentUTC&"000001.0Z"

'Create AD Connection
Set oConnection1 = CreateObject("ADODB.Connection")
Set oCommand1 = CreateObject("ADODB.Command")
oConnection1.Provider = "ADsDSOObject" ' This is the ADSI OLE-DB provider name
oConnection1.Open "Active Directory Provider"
' Create a command object for this connection.
Set oCommand1.ActiveConnection = oConnection1
'Set Query definition
' тут задаем доменные параметры берем из AD
oCommand1.CommandText = "select mail from 'LDAP://DC=it, DC=local' WHERE objectCategory='Person' AND objectClass='user'AND msExchHideFromAddressLists<>'True' AND whenCreated>='" & strDate & "'"

oCommand1.Properties("Page Size") = 30000
' Execute the query.
Set rs = oCommand1.Execute


rs.movefirst
'Create the loop of results
Do Until rs.EOF = True


'Create Email
' настройки письма для пользователя
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "Admin@mycantora.ua"
objEmail.To = rs.Fields("mail")
'Optional BCC field
'objEmail.BCC = "Admin@mycantora.ua"
objEmail.Subject = "A welcome message from Exchange"
objEmail.TextBody = "Добро пожаловать в ........."

objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/languagecode") = 1049
objEmail.BodyPart.CharSet = "utf-8".
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/usemessageresponsetext") = true


'Optional Add an attachment
'objEmail.AddAttachment "C:\new_hire_audio_message.wav"

objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing ") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver ") = _
"ExchangeServer" 'Replace ExchangeServer with server IP or name
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport ") = 25
objEmail.Configuration.Fields.Update

'Optional - Read the message before it's sent
'MsgBox objEmail.GetStream.ReadText
objEmail.Send
rs.movenext
Loop

'Close AD Connection
oConnection1.close

[Odarchuk]

amel27, спасибо Тебе. Работает
Но вот теперь в скрипте не работае ШТМЛ форматирование текста :(
Как пофиксить?

UPD: Все сам пофиксил :)