Solved

vbs how to click OK on warning

Posted on 2013-10-28
29
299 Views
Last Modified: 2013-11-17
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

Enterprise Vault warning message
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
0
Comment
Question by:BakerSyd
  • 16
  • 13
29 Comments
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39638638
BakerSyd,

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:
Sub MySubroutine()
    On Error GoTo ErrHandler:
    Dim x As Integer
    x = "Creates Type Mismatch Error"
    Debug.Print "Error Ignored"
    
    Exit Sub
ErrHandler:
    ' Use the debug to find the error number you wnat to trap
    ' It will show in the immediate window
    ' You could also use a message box, but debug is nicer
    ' as it allows you to copy and paste
    Debug.Print Err.Number
    
    ' Set up the error handler to ignore your error
    If Err.Number = "13" Then
        Resume Next
    Else
        MsgBox Err.Number & " : " & Err.Description, vbCritical + vbSystemModal, "ScriptError"
    End If
End Sub

Open in new window


-Bear
0
 

Author Comment

by:BakerSyd
ID: 39640716
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.


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 + " &nbsp " +" M " + objldapuser.mobile + " &nbsp " + " F " + objldapuser.facsimileTelephoneNumber + "<br>"
Else
	SigFileStream.WriteLine "T " + objldapuser.telephoneNumber + " &nbsp " + " F " + objldapuser.facsimileTelephoneNumber + "<br>"  
END IF

SigFileStream.WriteLine "<a href="+ chr(34) +"mailto:"+ objldapuser.mail + chr(34) + ">" + objldapuser.mail + "</a>" + " &nbsp " + "<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

Open in new window

0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39641828
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:

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 If

Open in new window


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:
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

Open in new window


-Bear
0
 

Author Comment

by:BakerSyd
ID: 39643253
ok i got a error code 13 using the first code.

Error Code 13
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 then

Open in new window


is there a OR / AND possibly missing?
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39643390
Sorry it is missing an And.  Should be:
If Err.Number <> 0 and Err.Number <> 13 then

Open in new window


I find it interesting they are you getting a type mismatch.  Go ahead and change the line and see if that helps.
0
 

Author Comment

by:BakerSyd
ID: 39643417
ok i did that... i get the following error and the script ends.

error
it is pointing to this line

objWord.activedocument.SaveAs sSignatureName, 2 'txt

Open in new window


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.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39643470
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:
	If Err.Number <> 0 Err.Number <> 12345 then
		wscript.echo "Error Number=" & err.number & vbcrlf & err.description
	End If

Open in new window

To this:
	If Err.Number <> 0 Err.Number <> 12345 then
		wscript.echo "Error Number=" & err.number & vbcrlf & err.description
		Err.Clear
	End If

Open in new window


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:
wscript.echo sSignatureName

Open in new window


-Bear
0
 

Author Comment

by:BakerSyd
ID: 39643512
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

wscript.echo sSignatureName

Open in new window


sSignatureName

after this i get the same error as before pointing to the same code
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39643621
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:
objWord.activedocument.SaveAs sSignatureName, 2 'txt
objWord.activedocument.SaveAs sSignatureName, 6 ' rtf
'objWord.activedocument.SaveAs sSignatureName, 8 ' htm

Open in new window

With
If 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 If

Open in new window


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"
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

Open in new window


-Bear
0
 

Author Comment

by:BakerSyd
ID: 39643647
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.

cannot find path
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

Path not found
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")

Open in new window




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...
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39643655
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.
0
 

Author Comment

by:BakerSyd
ID: 39643665
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!
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39646969
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
0
 

Author Comment

by:BakerSyd
ID: 39646977
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?
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39647018
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 + " &nbsp " +" M " + g_objldapuser.mobile + " &nbsp " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"
	Else
		SigFileStream.WriteLine "T " + g_objldapuser.telephoneNumber + " &nbsp " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"  
	END IF

	SigFileStream.WriteLine "<a href="+ chr(34) +"mailto:"+ g_objldapuser.mail + chr(34) + ">" + g_objldapuser.mail + "</a>" + " &nbsp " + "<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 Function

Open in new window

0
 

Author Comment

by:BakerSyd
ID: 39647020
awesome!

ill try it out right now....
0
 

Author Comment

by:BakerSyd
ID: 39647026
i got an error on line 143

Set g_objldapuser = GetObject("LDAP://" & GetUserDN(g_sUserName, sDomainName))

Open in new window


getuserDN
edit: oh wait i just realised i have to fill in some blanks....

woops
0
 

Author Comment

by:BakerSyd
ID: 39649715
i filled in all the blanks and i still get the same error pointing to the GetUserDN line..
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39650059
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 + " &nbsp " +" M " + g_objldapuser.mobile + " &nbsp " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"
	Else
		SigFileStream.WriteLine "T " + g_objldapuser.telephoneNumber + " &nbsp " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"  
	END IF

	SigFileStream.WriteLine "<a href="+ chr(34) +"mailto:"+ g_objldapuser.mail + chr(34) + ">" + g_objldapuser.mail + "</a>" + " &nbsp " + "<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 Function

Open in new window

0
 

Author Comment

by:BakerSyd
ID: 39650075
getting closer!

got an error on line 314

objWord.activedocument.SaveAs sSignatureName, 2 'txt

Open in new window



objword saveas

i can confirm that it did create a new folder
but because of this error none of sigs were created
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39650092
OK.  Lets dig into that one.  Just before that saveas line replace this line
	wscript.echo "Saving Updated RTF / TXT"

Open in new window

with
	wscript.echo "Saving Updated RTF / TXT" & vbcrlf & sSignatureName 

Open in new window

And let me know what displays on that message box.

Also did the Vault window show up?
0
 

Author Comment

by:BakerSyd
ID: 39650096
ok i will do that now... and no the vault window did not show up
i saw nothing....
0
 

Author Comment

by:BakerSyd
ID: 39650136
message box says

saving updated RTF / TXT

saving rtf
then it fails with the same error as before.
0
 
LVL 20

Accepted Solution

by:
ltlbearand3 earned 500 total points
ID: 39650202
OK.  Found a couple more mistakes.  Try this:

Dim g_oFSO, g_sOutlookSigPath, g_sOutlookSigFile, g_blnUpdate
Dim g_sUserName, g_objldapuser, g_sAddress(3), g_sTel, g_sSignatureName

' Instantiate Global Variables
Set g_oFSO = CreateObject("Scripting.FileSystemObject")

iResult = 0
GetFileLocations
CheckforUpdate
If g_blnUpdate Then
	CreateSignatures
	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 CreateSignatures
	Dim oSignatureFile

	'**New
	GetADUserDetails

	sOutlookSigID = Ucase(g_sUserName) & "_Signature"
	g_sSignatureName = g_sOutlookSigPath & "\" & sOutlookSigID
	

	GetPostalAddress 
	CreateSignatureFiles
	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 GetPostalAddress

	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 CreateSignatureFiles

	wscript.echo "Creating new RTF and TXT Files" 

	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 = g_sUserName & "_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" & vbcrlf & g_sSignatureName 
	objWord.ActiveDocument.SaveAs g_sSignatureName, 2 'txt
	objWord.ActiveDocument.SaveAs g_sSignatureName, 6 ' rtf
	'objWord.activedocument.SaveAs g_sSignatureName, 8 ' htm

	objDoc.Saved = True
	objWord.Quit

end sub

' -----------------------------------------------------------------------------------

Public Sub Rebuild_HTM
	wscript.echo "Creating new HTM with line breaks" 
	wscript.echo g_sSignatureName
	Set SigFileStream = g_oFSO.CreateTextFile(g_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 + " &nbsp " +" M " + g_objldapuser.mobile + " &nbsp " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"
	Else
		SigFileStream.WriteLine "T " + g_objldapuser.telephoneNumber + " &nbsp " + " F " + g_objldapuser.facsimileTelephoneNumber + "<br>"  
	END IF

	SigFileStream.WriteLine "<a href="+ chr(34) +"mailto:"+ g_objldapuser.mail + chr(34) + ">" + g_objldapuser.mail + "</a>" + " &nbsp " + "<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 Function

Open in new window

0
 

Author Comment

by:BakerSyd
ID: 39650230
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...
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39650246
Great.  Sounds like a good plan to test a little more thoroughly and hopefully we have it.
0
 

Author Comment

by:BakerSyd
ID: 39650303
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!
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39650317
Glad it is working.  Just remember to close out the question and choose my last posting with the full script.
0
 

Author Closing Comment

by:BakerSyd
ID: 39655385
Brilliant work by Bear!
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

Suggested Solutions

This script will sweep a range of IP addresses (class c only, 255.255.255.0) and report to a log the version of office installed. What it does: 1.)      Creates log file in the directory the script is run from (if it doesn't already exist) 2.)      Sweep…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

24 Experts available now in Live!

Get 1:1 Help Now