Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - Подпись в Outlook VBS с заменой переменных из внешнего файла.

Ответить
Настройки темы
VBS/WSH/JS - Подпись в Outlook VBS с заменой переменных из внешнего файла.

Аватара для serraxer

Новый участник


Сообщения: 29
Благодарности: 0

Профиль | Отправить PM | Цитировать


Изменения
Автор: serraxer
Дата: 02-06-2017
Описание: Done
Привет, помогите доделать скрипт. Сейчас он создает подпись на основе AD, но попросили добавить к русским должностям находящимся в AD их английские версии, но берущиеся из файла accounts.txt

accounts.txt
В нем должности в таком виде (можно и в csv через ;,)
Системный администратор=System Administrator
Водитель=Driver

Застрял на моменте где надо сравнить с должностью на русском в AD и добавить на английском сравнив в файле.

Получится что то типа

С уважением / Your friend
Сашка Белый / Alex White
Системный администратор / System Administrator
T: +7(xxx) xxx xxx + xxxx |M: +7xxxxxxxxxx |E: White.a@email.ru

Сейчас скрипт смотрит одну из доп переменных в AD но этот вариант забраковали.


Скрытый текст
'
'
'Option Explicit
On Error Resume Next

Dim strSigName
Dim strFullName, strTitle, strmsExchExtensionCustomAttribute1, strCompany, strTel, strEmail, strWeb, strCorpEmail
Dim boolUpdateStyle
Dim sFirstName, sLastName, sMobile, sDisplayNamePrintable, sTelephoneNumber, sCity
Dim s
Dim oTitlesRUEN, oFSO, sFilePath, sLine,oIniFile, nPos, sKey, sValue, nCount, sPath, wshshell


'==========================================================================
' пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
'==========================================================================
'Set oFSO = CreateObject( "Scripting.FileSystemObject" )
'sPath = WScript.ScriptFullName
'Set oTitlesRUEN = CreateObject("Scripting.Dictionary")
'sFilePath = sPath & "\titles_ru_en.txt"
'nCount = 0
'If objFSO.FileExists( sFilePath ) Then
' Set oIniFile = objFSO.OpenTextFile( sFilePath, 1, False )
' Do While NOT oIniFile.AtEndOfStream AND nCount<100
'
' sLine = Trim( oIniFile.ReadLine )
' nCount = nCount + 1
' nPos=InsTR(1,sLine,"=",1)
' if nPos>0 Then
' sKey = UCase(Trim( Left( sLine, nPos - 1 ) ))
' sValue = Trim( Mid( sLine, nPos + 1 ) )
' oTitlesRUEN.Add sKey, sValue
' end If
' Loop
' oIniFile.Close()
'end if
'==========================================================================
' Some script variables
'==========================================================================


' Name signature
strSigName = "Signature"
' If signature exists, overwrite (true) or leave alone (false)?
boolUpdateStyle = true

'==========================================================================
' Set some static information
'==========================================================================

' Company information
strCompany = "Your Company Name"
strTel = "+7(xxx) xxx xxxxxx"
strWeb = "http://www.yourdomain.com"

' Fallback email address when no address is found
strCorpEmail = "contact@yourdomain.com"

'==========================================================================
' Read User's Active Directory information
'==========================================================================
Dim objSysInfo, objUser

Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.Username)

strFullName = objUser.displayname
strTitle = objUser.title
strEnTitle = objUser.msExchExtensionCustomAttribute1
strEmail = LCase(objuser.emailaddress)

sFirstName = objUser.givenName
sLastName = objUser.sn
sMobile = objUser.mobile
sDisplayNamePrintable = objUser.displayNamePrintable
sTelephoneNumber = Trim(objUser.telephoneNumber)
sCity = objUser.l

If Trim(strTitle) = "" Then strTitle = "_"
If Trim(strEnTitle) = "" Then strmsExchExtensionCustomAttribute1 = "_"
If Trim(strEmail) = "" Then strEmail = strCorpEmail
if Len(sTelephoneNumber)>0 Then
strTel = strTel & " + " & sTelephoneNumber
end If
Set objUser = Nothing
Set objSysInfo = Nothing


'==========================================================================
' Get Signature Folder
'==========================================================================
Dim objShell
Set objShell = CreateObject("WScript.Shell")
strSigFolder = ObjShell.ExpandEnvironmentStrings("%appdata%") & "\Microsoft\Signatures\"
Set objShell = Nothing


'==========================================================================
' Get Signature Folder
'==========================================================================
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")

If Not (objFSO.FolderExists(strSigFolder)) Then
Call objFSO.CreateFolder(strSigFolder)
End If

strHTMFile = strSigFolder & strSigName & ".htm"
strRTFFile = strSigFolder & strSigName & ".rtf"
strTXTFile = strSigFolder & strSigName & ".txt"


'==========================================================================
' Create HTM File
'==========================================================================
'chr(47) = /

Err.Clear
Set objFile = objFSO.CreateTextFile(strHTMFile, boolUpdateStyle, False)
If Err.Number = 0 Then
s = ""
s = s & "<html> <head> <title>Spectrum Group<" & Chr(47) & "title>"&vbCrLf
s = s & "<meta http-equiv=Content-Type content=" & chr(34) & "text/html; charset=windows-1251" & chr(34) & ">"&vbCrLf
s = s & "<" & Chr(47) & "head>"
s = s & "<body style=""FONT-SIZE: 10pt; COLOR:rgb(31,73,125); FONT-FAMILY: Calibri"">"&vbCrLf

s = s & "<hr /><p><div>"&vbCrLf
s = s & "С уважением&nbsp;/&nbsp;Yours&nbsp;faithfully<br />"&vbCrLf
s = s & "<b>" & sFirstName & "&nbsp;" & sLastName& " / "& sDisplayNamePrintable & "</b><br />"
s = s & strTitle& " / "& strEnTitle & "</b><br />"&vbCrLf
's = s & "</i>"
' s = s & "<img src=http://xxx.xx/images/logo.png style=width:260px;height:70px></b><br />"&vbCrLf
s = s & "T:&nbsp;" & strTel
if Len(sMobile)>0 Then
s = s & "&nbsp;|M:&nbsp;" & sMobile
end If
s = s & "&nbsp;|E:&nbsp;<a href=""mailto:" & strEmail & """>" & strEmail & "</a>"&vbCrLf
s = s & "</div></p>"
s = s & "<" & Chr(47) & "body> <" & Chr(47) & "html>"
objFile.Write s
objFile.close
End If

'==========================================================================
' Create TXT File
'==========================================================================
Err.Clear
Set objFile = objFSO.CreateTextFile(strTXTFile, boolUpdateStyle, False)
If Err.Number = 0 Then
objFile.Write "Суважением/Your faithfully"&vbCrLf
objFile.Write sFirstName & " " & sLastName & " / "& sDisplayNamePrintable &vbCrLf
objFile.Write strTitle & " / "& strEnTitle &vbCrLf
objFile.Write "T: " & strTel
if Len(sMobile)>0 Then
objFile.Write " |M: " & sMobile
end If
objFile.Write " |E: " & strEmail &vbCrLf
objFile.close
End If


'==========================================================================
' Create RTF File
'==========================================================================
Err.Clear
Set objFile = objFSO.CreateTextFile(strRTFFile, boolUpdateStyle, False)
If Err.Number = 0 Then
objfile.write "{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fprq2\fcharset0 Calibri;}{\f1\froman\fprq2\fcharset2 Webdings;}}" & vbCrLF
objfile.write "{\colortbl;\red031\green073\blue125;\red0\green0\blue255;\red0\green128\blue0;}" & vbCrLF
objfile.write "{\*\generator Msftedit 5.41.15.1507;}\viewkind4\uc1\pard\sb100\sa100\cf1\lang2057\f0\fs20 " & strFullName & "\line "
objfile.write strTitle & "\line " & strCompany & "\line T: " & strTel & "\line E: "
objfile.write "{\field{\*\fldinst{HYPERLINK ""mailto:" & strEmail & """}}{\fldrslt{\ul " & strEmail & "}}}\ulnone\f0\fs20 "
'objfile.write "{\field{\*\fldinst{HYPERLINK """ & strWeb & """}}{\fldrslt{\ul " & strWeb & "}}}\ulnone\f0\fs20\par" & vbCrLF
objfile.write "\cf3\f1\fs36 P\fs20 \f0 Please consider the environment - do you really need to print this email?\par" & vbCrLF
objfile.write "\pard\cf1\lang1033\par" & vbCrLF
objfile.write "}" & vbCrLF
objFile.close
End If

'==========================================================================
' Write to registry
'==========================================================================
On error resume next
Set wshshell = WScript.CreateObject("WScript.Shell")
wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Common\MailSettings\NewSignature", strSigName
wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\MailSettings\NewSignature", strSigName
wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Common\MailSettings\NewSignature", strSigName

wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Common\MailSettings\ReplySignature", strSigName
wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\MailSettings\ReplySignature", strSigName
wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Common\MailSettings\ReplySignature", strSigName
On error goto 0
'==========================================================================
' Tidy-up
'==========================================================================
set objFile = Nothing
set objFSO = Nothing

Set objWord = CreateObject("Word.Application")
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
objSignatureObject.NewMessageSignature = "Signature"
objSignatureObject.ReplyMessageSignature = "Signature"

MsgBox "Signatures Ok"
'==========================================================================
' Windows Registry Editor Version 5.00
' http://www.askit.ru/custom/progr_adm...1_registry.htm

' [HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Outlook\Setup]
' "First-Run"=-

' [HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\MailSettings]
' "NewSignature"="Standard Signature"
' "ReplySignature"="Standard Signature"

Отправлено: 16:19, 01-06-2017

 

Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


Цитата serraxer:
попросили добавить к русским должностям они уже находятся в AD из английские версии но берущиеся из файла accounts.txt »
Попробуйте расставить запятые.
Это сообщение посчитали полезным следующие участники:

Отправлено: 16:48, 01-06-2017 | #2



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

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


Аватара для serraxer

Новый участник


Сообщения: 29
Благодарности: 0

Профиль | Отправить PM | Цитировать


Цитата Iska:
Попробуйте расставить запятые. »
Да, запятые вечный мой враг ещё со школьной скамьи.

Отправлено: 10:32, 02-06-2017 | #3


Новый участник


Сообщения: 9
Благодарности: 0

Профиль | Отправить PM | Цитировать


Проблема не решена?
Не нашел где у вас в коде происходит сравнение....
Цитата serraxer:
Застрял на моменте где надо сравнить с должностью на русском в AD и добавить на английском сравнив в файле. »
Цитата serraxer:
'Set oTitlesRUEN = CreateObject("Scripting.Dictionary")
'sFilePath = sPath & "\titles_ru_en.txt"
'nCount = 0
'If objFSO.FileExists( sFilePath ) Then
' Set oIniFile = objFSO.OpenTextFile( sFilePath, 1, False )
' Do While NOT oIniFile.AtEndOfStream AND nCount<100
'
' sLine = Trim( oIniFile.ReadLine )
' nCount = nCount + 1
' nPos=InsTR(1,sLine,"=",1)
' if nPos>0 Then
' sKey = UCase(Trim( Left( sLine, nPos - 1 ) ))
' sValue = Trim( Mid( sLine, nPos + 1 ) )
' oTitlesRUEN.Add sKey, sValue
' end If
' Loop
' oIniFile.Close()
'end if »
Не проще использовать массив? И провести сравнение поиском или просто перебором.

Последний раз редактировалось nexochyka, 08-06-2017 в 11:47.


Отправлено: 11:41, 08-06-2017 | #4



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » VBS/WSH/JS - Подпись в Outlook VBS с заменой переменных из внешнего файла.

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
VBS/WSH/JS - VBS. Прочитать определенные строки из файла alex1985khv Скриптовые языки администрирования Windows 3 03-11-2015 03:16
PowerShell - Поиск в AD по строке из внешнего файла. Gluteus Maximus Скриптовые языки администрирования Windows 1 03-09-2015 10:08
VBS/WSH/JS - передача переменных bat>vbs Imago_ Скриптовые языки администрирования Windows 2 23-06-2015 18:50
CMD/BAT - [решено] определение переменных в путях из файла и icq99999999 Скриптовые языки администрирования Windows 1 08-11-2014 16:16
VBS/WSH/JS - [решено] Картинка-подпись генерируемая vbs для Outlook Black_Sun Скриптовые языки администрирования Windows 12 28-08-2014 15:42




 
Переход