PDA

Показать полную графическую версию : Подпись в Outlook VBS с заменой переменных из внешнего файла.

serraxer
01-06-2017, 16:19
Привет, помогите доделать скрипт. Сейчас он создает подпись на основе 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_admin/m11/11_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"
Iska
01-06-2017, 16:48
попросили добавить к русским должностям они уже находятся в AD из английские версии но берущиеся из файла accounts.txt »
Попробуйте расставить запятые.
serraxer
02-06-2017, 10:32
Попробуйте расставить запятые. »
Да, запятые вечный мой враг ещё со школьной скамьи.
nexochyka
08-06-2017, 11:41
Проблема не решена?
Не нашел где у вас в коде происходит сравнение....
Застрял на моменте где надо сравнить с должностью на русском в AD и добавить на английском сравнив в файле. »

'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 »
Не проще использовать массив? И провести сравнение поиском или просто перебором.



© OSzone.net 2001-2012