vbs how to click OK on warning
hi
i am working on modifying our signature script to incorporate a new layout.
now this part of the work was fairly easy and its good to go...
but im finding when the script runs it launches up the following warning
the warning does not stop the script from creating the signatures, its just annoying that it pops up...
my question is... is it possible to script up a code so that while it builds the signatures (htm, rtf, txt) when that warning message pops up it automatically clicks ok?
ive googled this a bit but cant find anything definite that its actually possible.
so my thinking is that
if warning message contains "Enterprise Vault"
then click OK
but ive got no idea how to script it ... or if its even possible?
any ideas?
let me know if you need any more info....
many thanks
i am working on modifying our signature script to incorporate a new layout.
now this part of the work was fairly easy and its good to go...
but im finding when the script runs it launches up the following warning
the warning does not stop the script from creating the signatures, its just annoying that it pops up...
my question is... is it possible to script up a code so that while it builds the signatures (htm, rtf, txt) when that warning message pops up it automatically clicks ok?
ive googled this a bit but cant find anything definite that its actually possible.
so my thinking is that
if warning message contains "Enterprise Vault"
then click OK
but ive got no idea how to script it ... or if its even possible?
any ideas?
let me know if you need any more info....
many thanks
ASKER
heya
thanks for replying... a error code checker would be good if we can get it working.
if you scroll down to line 270-277, this is when that enterprise vault window shows up.
pretty sure it was at line 274... step 2
for whatever reason at that particular moment it would pop up...
i will try and implement your code above and see what happens.
thanks for replying... a error code checker would be good if we can get it working.
if you scroll down to line 270-277, this is when that enterprise vault window shows up.
pretty sure it was at line 274... step 2
for whatever reason at that particular moment it would pop up...
i will try and implement your code above and see what happens.
public oWord
public StrAddress(3)
public StrTel
Public sSignatureName, sOutlookSigID, sUname, sUpath, sOutlookSigPath, sOutlookSigfile
Public oShell, FSO, UpdateSig
'**New
public objUser, username, DomainName
public objldapuser
UpdateSig = 0
GetFileLocations
CheckforUpdate
CreateSignature
DeleteOldSignatures
If UpdateSig = 1 Then
wscript.echo sOutlookSigID & " Has been updated and set for New/Reply"
End If
If updateSig = 0 Then
wscript.echo sOutlookSigID & " Has been updated"
End IF
'***************************************************************************************************************
Sub CheckforUpdate ()
If FSO.FolderExists(sOutlookSigPath) = False Then
wscript.echo "No Outlook has not been used yet"
UpdateSig = 1
Else
wscript.echo "Sig Folder exists"
If FSO.FileExists(sOutlookSigfile) = True Then
'wscript.echo "Sig File exists - checking IP"
'Check if Melbourne ie IP XX.XXX.
'if instr(1,GetIPAddress, "xx.xxx.", 1) > 0 then
Set oScriptFile = FSO.GetFile("PATH")
'Set oScriptFile = FSO.GetFile("PATH")
Set oSignatureFile = FSO.GetFile(sOutlookSigfile)
wscript.echo "Script Date: " & oScriptFile.DateLastModified & " Sig Date: " & oSignatureFile.DateLastModified
If oScriptFile.DateLastModified <= oSignatureFile.DateLastModified Then
wscript.echo "Need to update but not set for use"
'*********** here is the line you want to rem out ********************
wscript.quit
' No update required as template is younger then signatures
Set oScriptFile = Nothing
Set oSignatureFile = Nothing
UpdateSig = 0
'wscript.echo "Exiting: Sig update not required.", vbExclamation
Exit Sub
Else
wscript.echo "Vbscript Date greater than vbscript"
UpdateSig = 1
End If
'else
REM wscript.echo "LOC1 - not updating"
REM UpdateSig = 0
REM wscript.quit
'end if
Else
wscript.echo "Sig File not there"
UpdateSig = 1
End If
End If
End Sub
'**************************************************************************************************
Sub CreateSignature()
Dim oSignatureFile
'**New
GetADUserDetails
sOutlookSigID = Ucase(username) & "_Signature"
sSignatureName = sOutlookSigPath & "\" & sOutlookSigID
sGetAddress ()
sCreateRtf ()
Rebuild_htm
end Sub
'**New
Function GetUserDN(ByVal UN, ByVal DN)
dim objTrans
dim struserdn
Set objTrans = CreateObject("NameTranslate")
objTrans.init 1, DN
objTrans.Set 3, DN & "\" & UN
struserdn = objTrans.Get(1)
GetUserDN = struserdn
End Function
'Get user details from AD
'*****************************
Sub GetADUserDetails()
Set objUser = CreateObject("WScript.Network")
username = objUser.username
DomainName = objUser.UserDomain
'username = "ausvl1" put in different username for testing
Set objldapuser = GetObject("LDAP://" & GetUserDN(username, DomainName))
'wscript.echo "Ldap details are: " & objldapuser.DisplayName & ", " & objldapuser.title
'Format fields as required
CheckTitle(objldapuser.title)
objldapuser.DisplayName = ReverseName(objldapuser.DisplayName)
objldapuser.mail = lcase(objldapuser.mail)
End Sub
'Standardise Partners title
'********************************************************************************************
Public sub CheckTitle(sTitle)
If UCase(sTitle) = UCase("Title") Or UCase(sTitle) = UCase("Title") Then
objldapuser.Title = "Title"
ElseIf UCase(sTitle) <> UCase("Title") Then
If InStr(LCase(sTitle), "Title") <> 0 Then
objldapuser.Title = "Title"
End If
else
objldapuser.Title = sTitle
End If
End sub
'*************************************************************************************************
Public Sub sGetAddress ()
If ucase(objldapuser.physicalDeliveryOfficeName) = "office" then
StrAddress(1) = "address, "
StrAddress(2) = "address, "
StrAddress(3) = objldapuser.l + " " + objldapuser.st + " " + objldapuser.postalcode + ", " + objldapuser.co
StrTel = "phone"
End If
If ucase(objldapuser.physicalDeliveryOfficeName) = "office2" then
StrAddress(1) = "address "
StrAddress(2) = "address "
StrAddress(3) = objldapuser.l + " " + objldapuser.st + " " + objldapuser.postalcode + ", " + objldapuser.co
StrTel = "phone"
End IF
If ucase(objldapuser.physicalDeliveryOfficeName) = "office 3" then
StrAddress(1) = "address "
StrAddress(2) = "address "
StrAddress(3) = "Bonifacio Global City, " + " " + objldapuser.l + ", " + objldapuser.st + " " + objldapuser.postalcode + ", " + objldapuser.co
StrTel = "phone"
End IF
End Sub
'*******************************************************************************************
Public Function ReverseName(sName)
Dim sFirstName
Dim sLastName
sFirstName = Trim(sGetRightUntil(sName, ","))
sLastName = Trim(sGetLeftUntil(sName, ","))
ReverseName = sFirstName & " " & sLastName
End Function
'******************************************************************************************
Public Function sGetRightUntil(sInputString, sUntil)
Do While InStr(sUntil, Right(sInputString, 1)) = 0 'The character is not in the sUntil string
sGetRightUntil = Right(sInputString, 1) & sGetRightUntil
sInputString = sRemoveRight(sInputString, 1)
Loop
End Function
'**********************************************************************************************
Public Function sGetLeftUntil(ByVal sInputString, sUntil)
Do While InStr(sUntil, Left(sInputString, 1)) = 0 'The character is not in the sUntil string
sGetLeftUntil = sGetLeftUntil & Left(sInputString, 1)
sInputString = sRemoveLeft(sInputString, 1)
Loop
End Function
'**************************************************************************************************
Public Function sRemoveRight(ByVal sInputString, iTrim)
sRemoveRight = Left(sInputString, Len(sInputString) - iTrim)
End Function
'****************************************************************************************************
Public Function sRemoveLeft(ByVal sInputString, iTrim)
sRemoveLeft = Right(sInputString, Len(sInputString) - iTrim)
End Function
'*************************************************************************************************
Public Sub GetFilelocations
Set oShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
sUname = UCase(oShell.ExpandEnvironmentStrings("%username%"))
sUpath = LCase(oShell.ExpandEnvironmentStrings("%userprofile%"))
sOutlookSigPath = sUpath & "\Application Data\Microsoft\Signatures"
sOutlookSigfile = sOutlookSigPath + "\" + Ucase(sUname) + "_Signature.txt"
'Set oShell = Nothing
End Sub
'************************************************************************************************
Public Sub sCreateRtf ()
wscript.echo "Creating new RTF"
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objword.selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
objSelection.Style = "No Spacing" 'keep spacing always on top
objSelection.font.name = "Arial"
objSelection.font.size = "10"
objSelection.font.bold = true
objSelection.Typetext objldapuser.DisplayName
objSelection.TypeParagraph()
objSelection.font.size = 10
objSelection.font.bold = False
objSelection.TypeText objldapuser.Title
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.font.name = "Arial"
objSelection.font.size = 8
objSelection.TypeText "name "
objSelection.TypeText strAddress(1) & " "
objSelection.TypeText strAddress(2) & " "
objSelection.TypeText strAddress(3)
objSelection.TypeParagraph()
'use the first IF statement to add Title for mobile
'IF objldapuser.title="Title" OR objldapuser.title="Title" OR objldapuser.title="Title" OR objldapuser.title="Title" OR InStr(LCase(objldapuser.title), "Title") <> 0 Then
IF objldapuser.title="Title" OR objldapuser.title="Title" OR objldapuser.title="Title" OR objldapuser.title="Title" Then
objSelection.TypeText "T " + objldapuser.telephoneNumber & " " & " "
objSelection.TypeText "M " + objldapuser.mobile & " " & " "
objSelection.TypeText "F " + objldapuser.facsimileTelephoneNumber
Else
objSelection.TypeText "T " + objldapuser.telephoneNumber & " " & " "
objSelection.TypeText "F " + objldapuser.facsimileTelephoneNumber
END IF
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Typetext objldapuser.mail
objSelection.HomeKey , True
objSelection.Hyperlinks.Add objSelection.Range, "mailto:" & objSelection.Text, "", "", objSelection.Text
objSelection.Font.Color = 1
objSelection.HomeKey , True
objSelection.Font.Color = 1
objSelection.EndKey , True
objSelection.TypeText " "
objSelection.Hyperlinks.Add objSelection.Range, "web" & objSelection.Text,,,"web"
objSelection.HomeKey , True
objSelection.font.name = "Arial"
objSelection.font.size = 8
objSelection.Font.Color = 1
objSelection.EndKey , True
objSelection.EndKey , True
Set objSelection = objDoc.Range()
SigName = username & "_Signature"
If UpdateSig = 1 Then
wscript.echo "Sig for use New/Reply"
objSignatureEntries.Add SigName, objSelection
'wscript.echo "step 1"
objSignatureObject.NewMessageSignature = SigName
'wscript.echo "step 2"
objSignatureObject.ReplyMessageSignature = SigName
'wscript.echo "step 3"
End If
wscript.echo "Saving Updated RTF / TXT"
objWord.activedocument.SaveAs sSignatureName, 2 'txt
objWord.activedocument.SaveAs sSignatureName, 6 ' rtf
'objWord.activedocument.SaveAs sSignatureName, 8 ' htm
objDoc.Saved = True
objWord.Quit
end sub
'*****************************************************************************************
Public Sub Rebuild_HTM
wscript.echo "Creating new HTM with line breaks"
wscript.echo sSignatureName
Set SigFileStream = FSO.CreateTextFile(sSignatureName + ".htm")
SigFileStream.WriteLine "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 3.2//EN"">"
SigFileStream.WriteLine "<HTML><HEAD><META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=iso-8859-1""><META NAME=""Generator"" CONTENT=""MS Exchange Server version 5.5.2163.0""><TITLE></TITLE></HEAD>"
SigFileStream.WriteLine "<BODY link=Black>"
SigFileStream.WriteLine "<P><FONT SIZE=2 FACE=""Arial""><STRONG>"
SigFileStream.WriteLine objldapuser.DisplayName + "<br>"
SigFileStream.WriteLine "</STRONG>" + objldapuser.Title + "<br>"
SigFileStream.WriteLine "<br>"
SigFileStream.WriteLine "<FONT SIZE=1 FACE=""Arial"">name" + "<br>"
SigFileStream.WriteLine StrAddress(1) + StrAddress(2) + StrAddress(3) + "<br>"
'use the first IF statement to add Title for mobile
'IF objldapuser.title="Title" OR objldapuser.title="Title" OR objldapuser.title="Title" OR objldapuser.title="Title" OR InStr(LCase(objldapuser.title), "Title") <> 0 Then
IF objldapuser.title="Title" OR objldapuser.title="Title" OR objldapuser.title="Title" OR objldapuser.title="Title" Then
SigFileStream.WriteLine " T " + objldapuser.telephoneNumber + "   " +" M " + objldapuser.mobile + "   " + " F " + objldapuser.facsimileTelephoneNumber + "<br>"
Else
SigFileStream.WriteLine "T " + objldapuser.telephoneNumber + "   " + " F " + objldapuser.facsimileTelephoneNumber + "<br>"
END IF
SigFileStream.WriteLine "<a href="+ chr(34) +"mailto:"+ objldapuser.mail + chr(34) + ">" + objldapuser.mail + "</a>" + "   " + "<A href="+ chr(34)+"httplink"+ chr(34)+ ">" + "web" + "</a>"
SigFileStream.WriteLine "<br>"
SigFileStream.WriteLine "<img border=0 width=192 height=95 src=pic.jpg>"
SigFileStream.WriteLine "</FONT></P></BODY></HTML>"
End Sub
'*************************************************************************************************
'*************************************************************************************************
Sub DeleteOldSignatures ()
wscript.echo "Deleting old sig files"
OldSigfile = sOutlookSigPath & "\" & objldapuser.DisplayName & "_Signature"
wscript.echo "looking for " & oldsigfile
If FSO.FileExists(OldSigfile & ".txt") = True Then
wscript.echo "Deleting Old " & OldSigFile & ".txt"
FSO.DeleteFile OldSigfile & ".txt", True
End If
If Err <> 0 then
wscript.echo err.discription & " : " & err.number & " Deleting .txt"
error.clear
End if
If FSO.FileExists(OldSigfile & ".rtf") = True Then
wscript.echo "Deleting Old " & OldSigFile & ".rtf"
FSO.DeleteFile OldSigfile & ".rtf", True
End If
If Err <> 0 then
wscript.echo err.discription & " : " & err.number & " Deleting .rtf"
error.clear
End if
If FSO.FileExists(OldSigfile & ".htm") = True Then
wscript.echo "Deleting Old " & OldSigFile & ".htm"
FSO.DeleteFile OldSigfile & ".htm", True
End If
If Err <> 0 then
wscript.echo err.discription & " : " & err.number & " Deleting .htm"
error.clear
End if
End Sub
'*************************************************************************************************
Function GetIPAddress()
Dim NIC, NICSet
Err.Clear
Set NICSet = GetObject("winmgmts:").ExecQuery("select * from Win32_NetworkAdapterConfiguration where IPEnabled=true")
For Each NIC In NICSet
GetIPAddress = NIC.IPaddress(0)
'xx.xxx and xx.xxx is loc1 and loc2 - pc's with VMWare have more than 1 IP
If InStr(1, GetIPAddress, "xx.xxx.", vbTextCompare) > 0 Or InStr(1, GetIPAddress, "xx.xxx.", vbTextCompare) > 0 Then
wscript.echo GetIPAddress
Exit For 'We have valid IP address
End If
Next
End Function
I had missed that this was vbscript and gave you some VBA code. Error handling in VBscript is a little different and this may not be as easy. Since you are working outside Outlook, we have to hope that the error is being returned to vbscript. If not, it becomes more difficult. First we have to find the error number. Try changing lines 269-277 with this:
Hopefully this will display the error number. If it does not, let me know. If it does write, down the error number and change lines 269-277 with this code and change the 12345 part of the If statement to the error number displayed above:
-Bear
If UpdateSig = 1 Then
On Error Resume Next
wscript.echo "Sig for use New/Reply"
objSignatureEntries.Add SigName, objSelection
'wscript.echo "step 1"
objSignatureObject.NewMessageSignature = SigName
'wscript.echo "step 2"
objSignatureObject.ReplyMessageSignature = SigName
'wscript.echo "step 3"
If Err.Number <> 0 then
wscript.echo "Error Number=" & err.number & vbcrlf & err.description
End If
End IfHopefully this will display the error number. If it does not, let me know. If it does write, down the error number and change lines 269-277 with this code and change the 12345 part of the If statement to the error number displayed above:
If UpdateSig = 1 Then
On Error Resume Next
wscript.echo "Sig for use New/Reply"
objSignatureEntries.Add SigName, objSelection
'wscript.echo "step 1"
objSignatureObject.NewMessageSignature = SigName
'wscript.echo "step 2"
objSignatureObject.ReplyMessageSignature = SigName
'wscript.echo "step 3"
If Err.Number <> 0 Err.Number <> 12345 then
wscript.echo "Error Number=" & err.number & vbcrlf & err.description
End If
On Error Goto 0
End If-Bear
ASKER
ok i got a error code 13 using the first code.
when i replace the code with the 2nd part and replace 12345 with 13
it says error: expected 'THEN'
and its pointing to this line
is there a OR / AND possibly missing?
when i replace the code with the 2nd part and replace 12345 with 13
it says error: expected 'THEN'
and its pointing to this line
If Err.Number <> 0 Err.Number <> 12345 thenis there a OR / AND possibly missing?
Sorry it is missing an And. Should be:
I find it interesting they are you getting a type mismatch. Go ahead and change the line and see if that helps.
If Err.Number <> 0 and Err.Number <> 13 thenI find it interesting they are you getting a type mismatch. Go ahead and change the line and see if that helps.
ASKER
ok i did that... i get the following error and the script ends.
it is pointing to this line
the first time i ran the additional code with "and" in it, the enterprise vault dialog box still popped up..
the 2nd time i ran it and it did not...not sure why.
it is pointing to this line
objWord.activedocument.SaveAs sSignatureName, 2 'txtthe first time i ran the additional code with "and" in it, the enterprise vault dialog box still popped up..
the 2nd time i ran it and it did not...not sure why.
A few things:
On the vault box showing up the first time and not the second - Was Outlook already running in either scenario? Did you get the new error both times or did one complete successfully?
One thing I noticed. Change this code:
On the new error, I would just add in a message box before that line for now to see if you can spot what is wrong with the file name:
-Bear
On the vault box showing up the first time and not the second - Was Outlook already running in either scenario? Did you get the new error both times or did one complete successfully?
One thing I noticed. Change this code:
If Err.Number <> 0 Err.Number <> 12345 then
wscript.echo "Error Number=" & err.number & vbcrlf & err.description
End If If Err.Number <> 0 Err.Number <> 12345 then
wscript.echo "Error Number=" & err.number & vbcrlf & err.description
Err.Clear
End IfOn the new error, I would just add in a message box before that line for now to see if you can spot what is wrong with the file name:
wscript.echo sSignatureName-Bear
ASKER
outlook wasnt open .... i just had a look and i had a lot of winword.exe instances running and 1 outlook instance.. so that explains why the EV popup box didnt show up.
i think whats happening is that when the script runs it launches word to create the rtf file... because the script crashes it doesnt have a chance to close winword... and outlook
the scenario for the users will be that outlook will not be open when this script runs.
the script will run during logon.. so im expecting the message box to pop up.
we have a small number of users with enterprise vault .. well at the moment anyways so its not really a major issue, but sometime in the future it could become a problem.
doing this before that line causing the error shows this
after this i get the same error as before pointing to the same code
i think whats happening is that when the script runs it launches word to create the rtf file... because the script crashes it doesnt have a chance to close winword... and outlook
the scenario for the users will be that outlook will not be open when this script runs.
the script will run during logon.. so im expecting the message box to pop up.
we have a small number of users with enterprise vault .. well at the moment anyways so its not really a major issue, but sometime in the future it could become a problem.
doing this before that line causing the error shows this
wscript.echo sSignatureNameafter this i get the same error as before pointing to the same code
We have two issues going on. Please close out all instances of outlook and winword from the task manager.
With the sSignatureName error, were you getting this before? Are you running the code differently with testing? In looking at your code, it should check for existence of that folder and be popping up a message that the path does not exist. Lets add some code just to check. Replace:
The enterprise vault error is probably being thrown by outlook since it is being started by the script and not a result of the script. add this code in after "objWord.Quit"
-Bear
With the sSignatureName error, were you getting this before? Are you running the code differently with testing? In looking at your code, it should check for existence of that folder and be popping up a message that the path does not exist. Lets add some code just to check. Replace:
objWord.activedocument.SaveAs sSignatureName, 2 'txt
objWord.activedocument.SaveAs sSignatureName, 6 ' rtf
'objWord.activedocument.SaveAs sSignatureName, 8 ' htmIf FSO.FileExists(sOutlookSigPath) Then
objWord.activedocument.SaveAs sSignatureName, 2 'txt
objWord.activedocument.SaveAs sSignatureName, 6 ' rtf
'objWord.activedocument.SaveAs sSignatureName, 8 ' htm
Else
wscript.echo "Cannot Find Path:" & vbcrlf & sOutlookSigPath & vbcrlf & "Trying to save file:" & vbcrlf & sSignatureName & vbcrlf & "VERIFY THAT PATHS MATCH AND EXIST"
End IfThe enterprise vault error is probably being thrown by outlook since it is being started by the script and not a result of the script. add this code in after "objWord.Quit"
Dim blnDone, objWscript, i
set objWscript = createobject("wscript.shell")
blnDone = False
i = 0
Do Until blnDone
' Counter to make sure we don't get stuck looking for the window
If objWscript.AppActivate("Enterprise Vault") Then
objWscript.Sendkeys "o{enter}"
blnDone = True
Else
i = i + 1
End If
If i > 50 then blnDone = True
wsh.sleep 50
Loop-Bear
ASKER
no i was not getting the sSignatureName error before.
its only started now since weve been tinkering with the code..
i made the modifications as you instructed and i got the following
- EV window popped up
- path name could not be found.
i tried creating the Signatures folder manually and the same error popped up.
the original code does 2 things
1. would detect if the signatures folder existed, if it didnt it would create it and then create the sigs.
2. if folder exists - check timestamp and update only if vbscript is newer. **this will be the case for 95% of our users
after clicking OK on both boxes the script continues and spills out the following error
it is pointing to the following code, line 4
i appreciate your help with this...
dont want you wasting your time trying to figure it out if its impossible to do... let me know if you cant be bothered coding any more.. :)
i can see why this one would be very tricky to do...
its only started now since weve been tinkering with the code..
i made the modifications as you instructed and i got the following
- EV window popped up
- path name could not be found.
i tried creating the Signatures folder manually and the same error popped up.
the original code does 2 things
1. would detect if the signatures folder existed, if it didnt it would create it and then create the sigs.
2. if folder exists - check timestamp and update only if vbscript is newer. **this will be the case for 95% of our users
after clicking OK on both boxes the script continues and spills out the following error
it is pointing to the following code, line 4
Public Sub Rebuild_HTM
wscript.echo "Creating new HTM with line breaks"
wscript.echo sSignatureName
Set SigFileStream = FSO.CreateTextFile(sSignatureName + ".htm")i appreciate your help with this...
dont want you wasting your time trying to figure it out if its impossible to do... let me know if you cant be bothered coding any more.. :)
i can see why this one would be very tricky to do...
A few things, the code you posted earlier does not actually create the folder if it does not exist. If just pushes along on it's merry way. We can add that in if you like. Can you verify if the folder actually exists? I read that you manually created it and it still could not find it, is that true?
Did the code close out the Enterprise Vault window or did you have to click OK yourself?
Can you post your code as it currently exists? I will try and look at this tomorrow and see what we can do.
Did the code close out the Enterprise Vault window or did you have to click OK yourself?
Can you post your code as it currently exists? I will try and look at this tomorrow and see what we can do.
ASKER
hmm ok... maybe the code when it creates the sigs automatically creates the signatures folder.
i can confirm that if i run the original vbs file it will create a signature folder if it does not exist.. then it creates the sigs etc.
so you are right.. it just does its thing.
im not sure why that part of the script has stopped working since we started tinkering... considering we havent touched that part.
yes when i created the folder manually it still did not find the location.
i had to close the enterprise vault window manually... the script did not close it.
no problem ill post up the code weve been working with soon...
thanks again!
i can confirm that if i run the original vbs file it will create a signature folder if it does not exist.. then it creates the sigs etc.
so you are right.. it just does its thing.
im not sure why that part of the script has stopped working since we started tinkering... considering we havent touched that part.
yes when i created the folder manually it still did not find the location.
i had to close the enterprise vault window manually... the script did not close it.
no problem ill post up the code weve been working with soon...
thanks again!
I took a look at your original script. Cleaned it up some and modified it to create the path, updated the reversename code to simplify and a few other things. I put in the code to hopefully close out the Enterprise Vault widow. Give this a try and let me know if it works. (If you don't like the new code, just post what you tried last on your code and we can just focus on it).
If the vault window does show up, and you leave it alone, does the script keep running?
-Bear
If the vault window does show up, and you leave it alone, does the script keep running?
-Bear
ASKER
hey Bear
sorry i havent gotten round to posting the script that weve been playing with so far.. been a bit busy.
thanks for looking at the script again and making some changes... will you post it up here so i can copy it?
sorry i havent gotten round to posting the script that weve been playing with so far.. been a bit busy.
thanks for looking at the script again and making some changes... will you post it up here so i can copy it?
Sorry - I forgot the import part of the script. Aaarrgh
Dim g_oFSO, g_sOutlookSigPath, g_sOutlookSigFile, g_blnUpdate
Dim g_sUserName, g_objldapuser, g_sAddress(3), g_sTel
' Instantiate Global Variables
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
iResult = 0
GetFileLocations
CheckforUpdate
If g_blnUpdate Then
CreateSignature
wscript.echo sOutlookSigID & " Has been updated and set for New/Reply"
End If
' -----------------------------------------------------------------------------------
' SUBROUTINES
' -----------------------------------------------------------------------------------
Sub GetFilelocations
Dim oShell, sUname, sUpath
Set oShell = CreateObject("WScript.Shell")
sUname = UCase(oShell.ExpandEnvironmentStrings("%username%"))
sUpath = LCase(oShell.ExpandEnvironmentStrings("%userprofile%"))
g_sOutlookSigPath = sUpath & "\Application Data\Microsoft\Signatures"
g_sOutlookSigFile = g_sOutlookSigPath + "\" + Ucase(sUname) + "_Signature.txt"
Set oShell = Nothing
End Sub
' -----------------------------------------------------------------------------------
Sub CheckforUpdate
If g_oFSO.FolderExists(g_sOutlookSigPath) then
wscript.echo "Sig Folder exists"
If g_oFSO.FileExists(g_sOutlookSigFile) Then
'wscript.echo "Sig File exists - checking IP"
'Check if Melbourne ie IP XX.XXX.
'if instr(1,GetIPAddress, "xx.xxx.", 1) > 0 then
Set oScriptFile = g_oFSO.GetFile("PATH")
'Set oScriptFile = g_oFSO.GetFile("PATH")
Set oSignatureFile = g_oFSO.GetFile(g_sOutlookSigFile)
wscript.echo "Script Date: " & oScriptFile.DateLastModified & " Sig Date: " & oSignatureFile.DateLastModified
If oScriptFile.DateLastModified <= oSignatureFile.DateLastModified Then
wscript.echo "Script Date is less than Signature Date." & vbcrlf & "No Update will be run"
g_blnUpdate=False
Else
wscript.echo "Script Date greater than Signature Date." & vbcrlf & "Running Update"
g_blnUpdate=True
End If
Set oScriptFile = Nothing
Set oSignatureFile = Nothing
'else
'wscript.echo "LOC1 - not updating"
' g_blnUpdate=False
'end if
Else
wscript.echo "No Signature File."
g_blnUpdate=True
End If
Else
wscript.echo "Signature Folder is missing. Creating Path"
CreatePath(g_sOutlookSigPath)
g_blnUpdate=True
End If
End Sub
' -----------------------------------------------------------------------------------
Sub CreatePath(PathToCreate)
Dim strFolders, strCurrentPath, intPosition, i
If Len(PathToCreate) = 0 Then
' Throw an error message since nothing was passed to Function
Err.Raise 76, , "There is no requested path to create. A valid path must be entered."
End If
' Make sure there is not a trailing \
If Right(PathToCreate, 1) = "\" Then PathToCreate = Left(PathToCreate, Len(PathToCreate) - 1)
' Split Path into an array
strFolders = Split(PathToCreate, "\")
' Check if UNC Path
If Left(PathToCreate, 2) = "\\" Then
strCurrentPath = "\\" & strFolders(2)
intPosition = 3
Else
strCurrentPath = strFolders(0)
intPosition = 1
End If
' Validate the Root Directory Exists
If g_oFSO.FolderExists(strCurrentPath) Then
' Loop through all SubFolders and Make sure they are created.
For i = intPosition To UBound(strFolders)
strCurrentPath = strCurrentPath & ("\" & strFolders(i))
If Not (g_oFSO.FolderExists(strCurrentPath)) Then
g_oFSO.CreateFolder strCurrentPath
End If
Next
Else
Err.Raise 76, , "Root Directory " & Chr(34) & strCurrentPath & _
Chr(34) & " could not be found." & vbCrLf & "Please verify that this location " & _
"exists before attempting operation again."
End If
End Sub
' -----------------------------------------------------------------------------------
Sub CreateSignature
Dim oSignatureFile
'**New
GetADUserDetails
sOutlookSigID = Ucase(g_sUserName) & "_Signature"
sSignatureName = g_sOutlookSigPath & "\" & sOutlookSigID
sGetAddress
sCreateRtf
Rebuild_htm
End Sub
' -----------------------------------------------------------------------------------
Sub GetADUserDetails()
Dim objUser, sDomainName
Set objUser = CreateObject("WScript.Network")
g_sUserName = objUser.username
sDomainName = objUser.UserDomain
'g_sUserName = "ausvl1" ' put in different username for testing
Set g_objldapuser = GetObject("LDAP://" & GetUserDN(g_sUserName, sDomainName))
'wscript.echo "Ldap details are: " & g_objldapuser.DisplayName & ", " & g_objldapuser.title
'Format fields as required
CheckTitle(g_objldapuser.title)
g_objldapuser.DisplayName = ReverseName(g_objldapuser.DisplayName)
g_objldapuser.mail = lcase(g_objldapuser.mail)
End Sub
' -----------------------------------------------------------------------------------
Sub CheckTitle(sTitle)
If UCase(sTitle) = UCase("Title") Or UCase(sTitle) = UCase("Title") Then
g_objldapuser.Title = "Title"
ElseIf UCase(sTitle) <> UCase("Title") Then
If InStr(LCase(sTitle), "Title") <> 0 Then
g_objldapuser.Title = "Title"
End If
Else
g_objldapuser.Title = sTitle
End If
End sub
' -----------------------------------------------------------------------------------
Function ReverseName(sNameToChange)
Dim sFirstName, SLastName
sFirstName = Right(sNameToChange, Len(sNameToChange)-instr(sNameToChange, ","))
sLastName = Left(sNameToChange, instr(sNameToChange, ",")-1)
ReverseName = sFirstName & " " & sLastName
End Function
' -----------------------------------------------------------------------------------
Sub sGetAddress
If ucase(g_objldapuser.physicalDeliveryOfficeName) = "office" then
g_sAddress(1) = "address, "
g_sAddress(2) = "address, "
g_sAddress(3) = g_objldapuser.l + " " + g_objldapuser.st + " " + g_objldapuser.postalcode + ", " + g_objldapuser.co
g_sTel = "phone"
End If
If ucase(g_objldapuser.physicalDeliveryOfficeName) = "office2" then
g_sAddress(1) = "address "
g_sAddress(2) = "address "
g_sAddress(3) = g_objldapuser.l + " " + g_objldapuser.st + " " + g_objldapuser.postalcode + ", " + g_objldapuser.co
g_sTel = "phone"
End IF
If ucase(g_objldapuser.physicalDeliveryOfficeName) = "office 3" then
g_sAddress(1) = "address "
g_sAddress(2) = "address "
g_sAddress(3) = "Bonifacio Global City, " + " " + g_objldapuser.l + ", " + g_objldapuser.st + " " + g_objldapuser.postalcode + ", " + g_objldapuser.co
g_sTel = "phone"
End IF
End Sub
' -----------------------------------------------------------------------------------
Public Sub sCreateRtf
wscript.echo "Creating new RTF"
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objword.selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
objSelection.Style = "No Spacing" 'keep spacing always on top
objSelection.font.name = "Arial"
objSelection.font.size = "10"
objSelection.font.bold = true
objSelection.Typetext g_objldapuser.DisplayName
objSelection.TypeParagraph()
objSelection.font.size = 10
objSelection.font.bold = False
objSelection.TypeText g_objldapuser.Title
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.font.name = "Arial"
objSelection.font.size = 8
objSelection.TypeText "name "
objSelection.TypeText g_sAddress(1) & " "
objSelection.TypeText g_sAddress(2) & " "
objSelection.TypeText g_sAddress(3)
objSelection.TypeParagraph()
'use the first IF statement to add Title for mobile
'IF g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR InStr(LCase(g_objldapuser.title), "Title") <> 0 Then
IF g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" Then
objSelection.TypeText "T " + g_objldapuser.telephoneNumber & " " & " "
objSelection.TypeText "M " + g_objldapuser.mobile & " " & " "
objSelection.TypeText "F " + g_objldapuser.facsimileTelephoneNumber
Else
objSelection.TypeText "T " + g_objldapuser.telephoneNumber & " " & " "
objSelection.TypeText "F " + g_objldapuser.facsimileTelephoneNumber
END IF
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Typetext g_objldapuser.mail
objSelection.HomeKey , True
objSelection.Hyperlinks.Add objSelection.Range, "mailto:" & objSelection.Text, "", "", objSelection.Text
objSelection.Font.Color = 1
objSelection.HomeKey , True
objSelection.Font.Color = 1
objSelection.EndKey , True
objSelection.TypeText " "
objSelection.Hyperlinks.Add objSelection.Range, "web" & objSelection.Text,,,"web"
objSelection.HomeKey , True
objSelection.font.name = "Arial"
objSelection.font.size = 8
objSelection.Font.Color = 1
objSelection.EndKey , True
objSelection.EndKey , True
Set objSelection = objDoc.Range()
sSigName = username & "_Signature"
If UpdateSig = 1 Then
wscript.echo "Sig for use New/Reply"
objSignatureEntries.Add sSigName, objSelection
'wscript.echo "step 1"
objSignatureObject.NewMessageSignature = sSigName
'wscript.echo "step 2"
objSignatureObject.ReplyMessageSignature = sSigName
'wscript.echo "step 3"
End If
' Attempt to Close out Enterprise Vault Window
Dim blnDone, objWscript, i
set objWscript = createobject("wscript.shell")
blnDone = False
i = 0
Do Until blnDone
' Counter to make sure we don't get stuck looking for the window
If objWscript.AppActivate("Enterprise Vault") Then
objWscript.Sendkeys "o{enter}"
blnDone = True
Else
i = i + 1
End If
If i > 100 then blnDone = True
wsh.sleep 100
Loop
wscript.echo "Saving Updated RTF / TXT"
objWord.activedocument.SaveAs sSignatureName, 2 'txt
objWord.activedocument.SaveAs sSignatureName, 6 ' rtf
'objWord.activedocument.SaveAs sSignatureName, 8 ' htm
objDoc.Saved = True
objWord.Quit
end sub
' -----------------------------------------------------------------------------------
Public Sub Rebuild_HTM
wscript.echo "Creating new HTM with line breaks"
wscript.echo sSignatureName
Set SigFileStream = g_oFSO.CreateTextFile(sSignatureName + ".htm")
SigFileStream.WriteLine "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 3.2//EN"">"
SigFileStream.WriteLine "<HTML><HEAD><META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=iso-8859-1""><META NAME=""Generator"" CONTENT=""MS Exchange Server version 5.5.2163.0""><TITLE></TITLE></HEAD>"
SigFileStream.WriteLine "<BODY link=Black>"
SigFileStream.WriteLine "<P><FONT SIZE=2 FACE=""Arial""><STRONG>"
SigFileStream.WriteLine g_objldapuser.DisplayName + "<br>"
SigFileStream.WriteLine "</STRONG>" + g_objldapuser.Title + "<br>"
SigFileStream.WriteLine "<br>"
SigFileStream.WriteLine "<FONT SIZE=1 FACE=""Arial"">name" + "<br>"
SigFileStream.WriteLine g_sAddress(1) + g_sAddress(2) + g_sAddress(3) + "<br>"
'use the first IF statement to add Title for mobile
'IF g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR InStr(LCase(g_objldapuser.title), "Title") <> 0 Then
IF g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" Then
SigFileStream.WriteLine " T " + g_objldapuser.telephoneNumber + "   " +" M " + g_objldapuser.mobile + "   " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"
Else
SigFileStream.WriteLine "T " + g_objldapuser.telephoneNumber + "   " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"
END IF
SigFileStream.WriteLine "<a href="+ chr(34) +"mailto:"+ g_objldapuser.mail + chr(34) + ">" + g_objldapuser.mail + "</a>" + "   " + "<A href="+ chr(34)+"httplink"+ chr(34)+ ">" + "web" + "</a>"
SigFileStream.WriteLine "<br>"
SigFileStream.WriteLine "<img border=0 width=192 height=95 src=pic.jpg>"
SigFileStream.WriteLine "</FONT></P></BODY></HTML>"
End Sub
' -----------------------------------------------------------------------------------
Sub DeleteOldSignatures ()
wscript.echo "Deleting old sig files"
OldSigfile = g_sOutlookSigPath & "\" & g_objldapuser.DisplayName & "_Signature"
wscript.echo "looking for " & oldsigfile
If g_oFSO.FileExists(OldSigfile & ".txt") Then
wscript.echo "Deleting Old " & OldSigFile & ".txt"
FSO.DeleteFile OldSigfile & ".txt", True
End If
If g_oFSO.FileExists(OldSigfile & ".rtf") Then
wscript.echo "Deleting Old " & OldSigFile & ".rtf"
FSO.DeleteFile OldSigfile & ".rtf", True
End If
If g_oFSO.FileExists(OldSigfile & ".htm") Then
wscript.echo "Deleting Old " & OldSigFile & ".htm"
FSO.DeleteFile OldSigfile & ".htm", True
End If
End Sub
'*************************************************************************************************
Function GetIPAddress()
Dim NIC, NICSet
Err.Clear
Set NICSet = GetObject("winmgmts:").ExecQuery("select * from Win32_NetworkAdapterConfiguration where IPEnabled=true")
For Each NIC In NICSet
GetIPAddress = NIC.IPaddress(0)
'xx.xxx and xx.xxx is loc1 and loc2 - pc's with VMWare have more than 1 IP
If InStr(1, GetIPAddress, "xx.xxx.", vbTextCompare) > 0 Or InStr(1, GetIPAddress, "xx.xxx.", vbTextCompare) > 0 Then
wscript.echo GetIPAddress
Exit For 'We have valid IP address
End If
Next
End FunctionASKER
awesome!
ill try it out right now....
ill try it out right now....
ASKER
i got an error on line 143
edit: oh wait i just realised i have to fill in some blanks....
woops
Set g_objldapuser = GetObject("LDAP://" & GetUserDN(g_sUserName, sDomainName))edit: oh wait i just realised i have to fill in some blanks....
woops
ASKER
i filled in all the blanks and i still get the same error pointing to the GetUserDN line..
Sorry somehow missed a piece of code. Try this (you will need to adjust the blanks again)
Dim g_oFSO, g_sOutlookSigPath, g_sOutlookSigFile, g_blnUpdate
Dim g_sUserName, g_objldapuser, g_sAddress(3), g_sTel
' Instantiate Global Variables
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
iResult = 0
GetFileLocations
CheckforUpdate
If g_blnUpdate Then
CreateSignature
wscript.echo sOutlookSigID & " Has been updated and set for New/Reply"
End If
' -----------------------------------------------------------------------------------
' SUBROUTINES
' -----------------------------------------------------------------------------------
Sub GetFilelocations
Dim oShell, sUname, sUpath
Set oShell = CreateObject("WScript.Shell")
sUname = UCase(oShell.ExpandEnvironmentStrings("%username%"))
sUpath = LCase(oShell.ExpandEnvironmentStrings("%userprofile%"))
g_sOutlookSigPath = sUpath & "\Application Data\Microsoft\Signatures"
g_sOutlookSigFile = g_sOutlookSigPath + "\" + Ucase(sUname) + "_Signature.txt"
Set oShell = Nothing
End Sub
' -----------------------------------------------------------------------------------
Sub CheckforUpdate
If g_oFSO.FolderExists(g_sOutlookSigPath) then
wscript.echo "Sig Folder exists"
If g_oFSO.FileExists(g_sOutlookSigFile) Then
'wscript.echo "Sig File exists - checking IP"
'Check if Melbourne ie IP XX.XXX.
'if instr(1,GetIPAddress, "xx.xxx.", 1) > 0 then
Set oScriptFile = g_oFSO.GetFile("PATH")
'Set oScriptFile = g_oFSO.GetFile("PATH")
Set oSignatureFile = g_oFSO.GetFile(g_sOutlookSigFile)
wscript.echo "Script Date: " & oScriptFile.DateLastModified & " Sig Date: " & oSignatureFile.DateLastModified
If oScriptFile.DateLastModified <= oSignatureFile.DateLastModified Then
wscript.echo "Script Date is less than Signature Date." & vbcrlf & "No Update will be run"
g_blnUpdate=False
Else
wscript.echo "Script Date greater than Signature Date." & vbcrlf & "Running Update"
g_blnUpdate=True
End If
Set oScriptFile = Nothing
Set oSignatureFile = Nothing
'else
'wscript.echo "LOC1 - not updating"
' g_blnUpdate=False
'end if
Else
wscript.echo "No Signature File."
g_blnUpdate=True
End If
Else
wscript.echo "Signature Folder is missing. Creating Path"
CreatePath(g_sOutlookSigPath)
g_blnUpdate=True
End If
End Sub
' -----------------------------------------------------------------------------------
Sub CreatePath(PathToCreate)
Dim strFolders, strCurrentPath, intPosition, i
If Len(PathToCreate) = 0 Then
' Throw an error message since nothing was passed to Function
Err.Raise 76, , "There is no requested path to create. A valid path must be entered."
End If
' Make sure there is not a trailing \
If Right(PathToCreate, 1) = "\" Then PathToCreate = Left(PathToCreate, Len(PathToCreate) - 1)
' Split Path into an array
strFolders = Split(PathToCreate, "\")
' Check if UNC Path
If Left(PathToCreate, 2) = "\\" Then
strCurrentPath = "\\" & strFolders(2)
intPosition = 3
Else
strCurrentPath = strFolders(0)
intPosition = 1
End If
' Validate the Root Directory Exists
If g_oFSO.FolderExists(strCurrentPath) Then
' Loop through all SubFolders and Make sure they are created.
For i = intPosition To UBound(strFolders)
strCurrentPath = strCurrentPath & ("\" & strFolders(i))
If Not (g_oFSO.FolderExists(strCurrentPath)) Then
g_oFSO.CreateFolder strCurrentPath
End If
Next
Else
Err.Raise 76, , "Root Directory " & Chr(34) & strCurrentPath & _
Chr(34) & " could not be found." & vbCrLf & "Please verify that this location " & _
"exists before attempting operation again."
End If
End Sub
' -----------------------------------------------------------------------------------
Sub CreateSignature
Dim oSignatureFile
'**New
GetADUserDetails
sOutlookSigID = Ucase(g_sUserName) & "_Signature"
sSignatureName = g_sOutlookSigPath & "\" & sOutlookSigID
sGetAddress
sCreateRtf
Rebuild_htm
End Sub
' -----------------------------------------------------------------------------------
Sub GetADUserDetails()
Dim objUser, sDomainName
Set objUser = CreateObject("WScript.Network")
g_sUserName = objUser.username
sDomainName = objUser.UserDomain
'g_sUserName = "ausvl1" ' put in different username for testing
Set g_objldapuser = GetObject("LDAP://" & GetUserDN(g_sUserName, sDomainName))
'wscript.echo "Ldap details are: " & g_objldapuser.DisplayName & ", " & g_objldapuser.title
'Format fields as required
CheckTitle(g_objldapuser.title)
g_objldapuser.DisplayName = ReverseName(g_objldapuser.DisplayName)
g_objldapuser.mail = lcase(g_objldapuser.mail)
End Sub
' -----------------------------------------------------------------------------------
Function GetUserDN(NameUser, NameDomain)
Dim objTrans
Set objTrans = CreateObject("NameTranslate")
objTrans.init 1, NameDomain
objTrans.Set 3, NameDomain & "\" & NameUser
GetUserDN = objTrans.Get(1)
End Function
' -----------------------------------------------------------------------------------
Sub CheckTitle(sTitle)
If UCase(sTitle) = UCase("Title") Or UCase(sTitle) = UCase("Title") Then
g_objldapuser.Title = "Title"
ElseIf UCase(sTitle) <> UCase("Title") Then
If InStr(LCase(sTitle), "Title") <> 0 Then
g_objldapuser.Title = "Title"
End If
Else
g_objldapuser.Title = sTitle
End If
End sub
' -----------------------------------------------------------------------------------
Function ReverseName(sNameToChange)
Dim sFirstName, SLastName
sFirstName = Right(sNameToChange, Len(sNameToChange)-instr(sNameToChange, ","))
sLastName = Left(sNameToChange, instr(sNameToChange, ",")-1)
ReverseName = sFirstName & " " & sLastName
End Function
' -----------------------------------------------------------------------------------
Sub sGetAddress
If ucase(g_objldapuser.physicalDeliveryOfficeName) = "office" then
g_sAddress(1) = "address, "
g_sAddress(2) = "address, "
g_sAddress(3) = g_objldapuser.l + " " + g_objldapuser.st + " " + g_objldapuser.postalcode + ", " + g_objldapuser.co
g_sTel = "phone"
End If
If ucase(g_objldapuser.physicalDeliveryOfficeName) = "office2" then
g_sAddress(1) = "address "
g_sAddress(2) = "address "
g_sAddress(3) = g_objldapuser.l + " " + g_objldapuser.st + " " + g_objldapuser.postalcode + ", " + g_objldapuser.co
g_sTel = "phone"
End IF
If ucase(g_objldapuser.physicalDeliveryOfficeName) = "office 3" then
g_sAddress(1) = "address "
g_sAddress(2) = "address "
g_sAddress(3) = "Bonifacio Global City, " + " " + g_objldapuser.l + ", " + g_objldapuser.st + " " + g_objldapuser.postalcode + ", " + g_objldapuser.co
g_sTel = "phone"
End IF
End Sub
' -----------------------------------------------------------------------------------
Public Sub sCreateRtf
wscript.echo "Creating new RTF"
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objword.selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
objSelection.Style = "No Spacing" 'keep spacing always on top
objSelection.font.name = "Arial"
objSelection.font.size = "10"
objSelection.font.bold = true
objSelection.Typetext g_objldapuser.DisplayName
objSelection.TypeParagraph()
objSelection.font.size = 10
objSelection.font.bold = False
objSelection.TypeText g_objldapuser.Title
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.font.name = "Arial"
objSelection.font.size = 8
objSelection.TypeText "name "
objSelection.TypeText g_sAddress(1) & " "
objSelection.TypeText g_sAddress(2) & " "
objSelection.TypeText g_sAddress(3)
objSelection.TypeParagraph()
'use the first IF statement to add Title for mobile
'IF g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR InStr(LCase(g_objldapuser.title), "Title") <> 0 Then
IF g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" Then
objSelection.TypeText "T " + g_objldapuser.telephoneNumber & " " & " "
objSelection.TypeText "M " + g_objldapuser.mobile & " " & " "
objSelection.TypeText "F " + g_objldapuser.facsimileTelephoneNumber
Else
objSelection.TypeText "T " + g_objldapuser.telephoneNumber & " " & " "
objSelection.TypeText "F " + g_objldapuser.facsimileTelephoneNumber
END IF
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Typetext g_objldapuser.mail
objSelection.HomeKey , True
objSelection.Hyperlinks.Add objSelection.Range, "mailto:" & objSelection.Text, "", "", objSelection.Text
objSelection.Font.Color = 1
objSelection.HomeKey , True
objSelection.Font.Color = 1
objSelection.EndKey , True
objSelection.TypeText " "
objSelection.Hyperlinks.Add objSelection.Range, "web" & objSelection.Text,,,"web"
objSelection.HomeKey , True
objSelection.font.name = "Arial"
objSelection.font.size = 8
objSelection.Font.Color = 1
objSelection.EndKey , True
objSelection.EndKey , True
Set objSelection = objDoc.Range()
sSigName = username & "_Signature"
If UpdateSig = 1 Then
wscript.echo "Sig for use New/Reply"
objSignatureEntries.Add sSigName, objSelection
'wscript.echo "step 1"
objSignatureObject.NewMessageSignature = sSigName
'wscript.echo "step 2"
objSignatureObject.ReplyMessageSignature = sSigName
'wscript.echo "step 3"
End If
' Attempt to Close out Enterprise Vault Window
Dim blnDone, objWscript, i
set objWscript = createobject("wscript.shell")
blnDone = False
i = 0
Do Until blnDone
' Counter to make sure we don't get stuck looking for the window
If objWscript.AppActivate("Enterprise Vault") Then
objWscript.Sendkeys "o{enter}"
blnDone = True
Else
i = i + 1
End If
If i > 100 then blnDone = True
wsh.sleep 100
Loop
wscript.echo "Saving Updated RTF / TXT"
objWord.activedocument.SaveAs sSignatureName, 2 'txt
objWord.activedocument.SaveAs sSignatureName, 6 ' rtf
'objWord.activedocument.SaveAs sSignatureName, 8 ' htm
objDoc.Saved = True
objWord.Quit
end sub
' -----------------------------------------------------------------------------------
Public Sub Rebuild_HTM
wscript.echo "Creating new HTM with line breaks"
wscript.echo sSignatureName
Set SigFileStream = g_oFSO.CreateTextFile(sSignatureName + ".htm")
SigFileStream.WriteLine "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 3.2//EN"">"
SigFileStream.WriteLine "<HTML><HEAD><META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=iso-8859-1""><META NAME=""Generator"" CONTENT=""MS Exchange Server version 5.5.2163.0""><TITLE></TITLE></HEAD>"
SigFileStream.WriteLine "<BODY link=Black>"
SigFileStream.WriteLine "<P><FONT SIZE=2 FACE=""Arial""><STRONG>"
SigFileStream.WriteLine g_objldapuser.DisplayName + "<br>"
SigFileStream.WriteLine "</STRONG>" + g_objldapuser.Title + "<br>"
SigFileStream.WriteLine "<br>"
SigFileStream.WriteLine "<FONT SIZE=1 FACE=""Arial"">name" + "<br>"
SigFileStream.WriteLine g_sAddress(1) + g_sAddress(2) + g_sAddress(3) + "<br>"
'use the first IF statement to add Title for mobile
'IF g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR InStr(LCase(g_objldapuser.title), "Title") <> 0 Then
IF g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" OR g_objldapuser.title="Title" Then
SigFileStream.WriteLine " T " + g_objldapuser.telephoneNumber + "   " +" M " + g_objldapuser.mobile + "   " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"
Else
SigFileStream.WriteLine "T " + g_objldapuser.telephoneNumber + "   " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"
END IF
SigFileStream.WriteLine "<a href="+ chr(34) +"mailto:"+ g_objldapuser.mail + chr(34) + ">" + g_objldapuser.mail + "</a>" + "   " + "<A href="+ chr(34)+"httplink"+ chr(34)+ ">" + "web" + "</a>"
SigFileStream.WriteLine "<br>"
SigFileStream.WriteLine "<img border=0 width=192 height=95 src=pic.jpg>"
SigFileStream.WriteLine "</FONT></P></BODY></HTML>"
End Sub
' -----------------------------------------------------------------------------------
Sub DeleteOldSignatures ()
wscript.echo "Deleting old sig files"
OldSigfile = g_sOutlookSigPath & "\" & g_objldapuser.DisplayName & "_Signature"
wscript.echo "looking for " & oldsigfile
If g_oFSO.FileExists(OldSigfile & ".txt") Then
wscript.echo "Deleting Old " & OldSigFile & ".txt"
FSO.DeleteFile OldSigfile & ".txt", True
End If
If g_oFSO.FileExists(OldSigfile & ".rtf") Then
wscript.echo "Deleting Old " & OldSigFile & ".rtf"
FSO.DeleteFile OldSigfile & ".rtf", True
End If
If g_oFSO.FileExists(OldSigfile & ".htm") Then
wscript.echo "Deleting Old " & OldSigFile & ".htm"
FSO.DeleteFile OldSigfile & ".htm", True
End If
End Sub
'*************************************************************************************************
Function GetIPAddress()
Dim NIC, NICSet
Err.Clear
Set NICSet = GetObject("winmgmts:").ExecQuery("select * from Win32_NetworkAdapterConfiguration where IPEnabled=true")
For Each NIC In NICSet
GetIPAddress = NIC.IPaddress(0)
'xx.xxx and xx.xxx is loc1 and loc2 - pc's with VMWare have more than 1 IP
If InStr(1, GetIPAddress, "xx.xxx.", vbTextCompare) > 0 Or InStr(1, GetIPAddress, "xx.xxx.", vbTextCompare) > 0 Then
wscript.echo GetIPAddress
Exit For 'We have valid IP address
End If
Next
End FunctionASKER
getting closer!
got an error on line 314
i can confirm that it did create a new folder
but because of this error none of sigs were created
got an error on line 314
objWord.activedocument.SaveAs sSignatureName, 2 'txti can confirm that it did create a new folder
but because of this error none of sigs were created
OK. Lets dig into that one. Just before that saveas line replace this line
Also did the Vault window show up?
wscript.echo "Saving Updated RTF / TXT" wscript.echo "Saving Updated RTF / TXT" & vbcrlf & sSignatureName Also did the Vault window show up?
ASKER
ok i will do that now... and no the vault window did not show up
i saw nothing....
i saw nothing....
ASKER
message box says
saving updated RTF / TXT
then it fails with the same error as before.
saving updated RTF / TXT
then it fails with the same error as before.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
oh my god i think youve done it... youre a genius
i made sure that no winword or outlook instances were running.
ran the script and it completed.. no enterprise vault box popped up either!
ill give this a proper test run and run it as if i was logging onto a pc to see what happens...
ill post back soon...
i made sure that no winword or outlook instances were running.
ran the script and it completed.. no enterprise vault box popped up either!
ill give this a proper test run and run it as if i was logging onto a pc to see what happens...
ill post back soon...
Great. Sounds like a good plan to test a little more thoroughly and hopefully we have it.
ASKER
looking good when it runs with the logonscript
no enterprise vault window
script will run for a new user where the signature folder doesnt exist .. it creates a folder and the sigs.
runs for existing users, updates sigs and creates a new time stamp.
logging on again a few minutes later and the sigs do not get touched as the time stamp stays the same.
awesome work Bear!
10000000 points for you!
no enterprise vault window
script will run for a new user where the signature folder doesnt exist .. it creates a folder and the sigs.
runs for existing users, updates sigs and creates a new time stamp.
logging on again a few minutes later and the sigs do not get touched as the time stamp stays the same.
awesome work Bear!
10000000 points for you!
Glad it is working. Just remember to close out the question and choose my last posting with the full script.
ASKER
Brilliant work by Bear!
I don't know if you are still watching your question. If so, I am wondering if your script has any error handling in it. My recommendation would be to use error handling to catch the error and not allow the error to be displayed. Could you post your code (minus any confidential information) and I can take a look and help you walk through error handling.
Here is a sample to get you started:
Open in new window
-Bear