Can anyone help me with this please.
I currently have a main logon script that I want to add another script to, that creates an Outlook dynamic signature.
Can someone help me please with where and how to add it.
Script 1
Option Explicit
Dim oShell, oNet, oFSO, oWshNetwork, oGroupDict, oDrives, i
Dim objenv
Const USF = "HKCU\Software\Microsoft\Windows\Currentversion\Explorer\User Shell Folders\"
Const SF = "HKCU\Software\Microsoft\Windows\Currentversion\Explorer\Shell Folders\"
Const IE = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\"
'----------------- Objects---------------------------
Set oShell = CreateObject("Wscript.Shell")
Set oNet = CreateObject("Wscript.Network")
set oFSO = CreateObject("Scripting.FileSystemObject")
Set OBJENV = oshell.Environment("Process")
Set oDrives = oNet.EnumNetworkDrives
oShell.Run("net time \\bc-exeter-01 /set /y")
'----------------------------------------------------
'---------MAIN FUNCTION CALL SECTION-----------------
Greeting()
'removedrives
Mapdrives
mapprinters
'regsettings
'DisplayResources()
'oshell.run("net time \\bc-exeter-01 /set /y")
' oShell.Run "Net Time /DomainomainName /set /yes",0,False
' oShell.Run("net TIME \\bc-exeter-01 /set /y")
Displayloggedin
'-----------------END (FUNCTION CALLS)---------------
Sub Mapprinters
mapprinter "\\bc-exeter-01\Exeter_Contracts_Laser_A4",false
mapprinter "\\bc-exeter-01\Exeter_Contracts_Laser_A3",false
mapprinter "\\bc-exeter-01\Exeter_Contracts_Laser_Letterhead",false
mapprinter "\\bc-exeter-01\Exeter_Colour_Laser",false
mapprinter "\\bc-exeter-01\Exeter_Accounts_Laser",false
mapprinter "\\bc-exeter-01\Exeter_Plotter",false
mapprinter "\\bc-exeter-01\Exeter_Colour_A3",false
End Sub
sub removedrives
dim odrives,loop1
'run through all the current mapped drives and remove them
on error resume next
set odrives=onet.enumnetworkdrives
for loop1=0 to (odrives.count-1) step 2
if odrives(loop1) <> "" then onet.removenetworkdrive odrives(loop1),true
next
end sub
'-------------------
Sub Mapdrives()
DriveMapper "t:", "\\bc-exeter-02\estv5"
DriveMapper "w:", "\\bc-exeter-01\work"
DriveMapper "p:", "\\bc-plymouth\work"
DriveMapper "y:", "\\bc-yeovil\work"
end sub
'--------------------
'----------------------FUNCTIONS----------------------
Function Greeting()
Dim sTime, sDate, sMessage, sAdsPath, GreetingTime, oUser
sTime = Hour(Now)
sDate = Now
If sTime <= 11 Then
GreetingTime = "morning"
ElseIf sTime <= 18 Then
GreetingTime = "afternoon"
Else
GreetingTime = "evening"
End If
sMessage = VbCrLf & sDate & VbCrLf & VbCrLf
sMessage = sMessage & "Good " & GreetingTime & " " & oNet.UserName & ","
sMessage = sMessage & VbCrLf
smessage = smessage & "You are now being logged into the system..."
oshell.popup sMessage,2,"Welcome to the Network. Please keep it tidy!"
End Function
'-----------------
'map the drives
Function MapDrive(Drive, Share)
'The following line checks for the drives existance
'unfortunatly x: is a dfs directory and so it could not be found
'hence I have quoted it out.
'If oFSO.DriveExists(FileServer & Share) = True Then oNet.MapNetworkDrive Drive, FileServer & Share
oNet.MapNetworkDrive Drive, FileServer & Share
End Function
Sub DriveMapper(Drive, Share)
For i = 0 to oDrives.Count -1 Step 2
if LCase(Drive) = LCase(oDrives.Item(i)) then
if not LCase(Share) = LCase(oDrives.Item(i+1)) then
oNet.RemoveNetworkDrive Drive, true, true
Else
Exit Sub
End if
End if
Next
'oShell.Popup("Drive: " & drive & " Share:" & share)
oNet.MapNetworkDrive Drive, Share
End Sub
'-----------------
Function Displayloggedin()
dim msgstring
MsgString = "You have been logged in to this workstation..." & VBCRLF
oshell.popup MsgString,2,"Network Login Complete."
end function
'----------------------------------
Function IsMember(sGroup)
Dim sAdsPath, oUser, oGroup
If IsEmpty(oGroupDict) Then
Set oGroupDict = CreateObject("Scripting.Dictionary")
oGroupDict.CompareMode = vbTextCompare
sAdsPath = oNet.UserDomain & "/" & oNet.UserName
Set oUser = GetObject("WinNT://" & sAdsPath & ",user")
For Each oGroup In oUser.Groups
oGroupDict.Add oGroup.Name, "-"
Next
Set oUser = Nothing
End If
IsMember = CBool(oGroupDict.Exists(sGroup))
End Function
PRIVATE SUB MapPrinter(thepath,isitdefault)
oNet.AddWindowsPrinterConnection thepath
If isitdefault=True Then oNet.SetDefaultPrinter thepath
'WScript.Echo "Your printer is mapped from : " & thepath
end sub
Script 2
On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strTitle = objUser.Title
strCompany = objUser.company
strMail = objUser.Mail
strWeb = objuser.wwwhomepage
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objRange = objDoc.Range()
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
objSelection.Font.Size = "11"
objSelection.Font.Name = "Calibri"
objSelection.ParagraphFormat.SpaceAfter = 0
objSelection.TypeText CHR(11)
objSelection.TypeText "Kind Regards"
objSelection.TypeText CHR(11)
objSelection.TypeText CHR(11)
objSelection.Font.Bold = true
objSelection.TypeText strName & ", "
objSelection.Font.Bold = false
objSelection.TypeText CHR(11)
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
objSelection.TypeText CHR(11)
objSelection.Font.Bold = true
objSelection.TypeText "Beale and Cole - Building Services"
objSelection.Font.Bold = false
objSelection.TypeText CHR(11)
objSelection.TypeText "T: 01392 825960"
objSelection.TypeText CHR(11)
objSelection.TypeText "F: 01392 825961"
objSelection.TypeText CHR(11)
objSelection.TypeText "E: " & strMail
objSelection.TypeText CHR(11)
objSelection.Hyperlinks.Add objselection.range, strWeb
Set objSelection = objDoc.Range()
objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"
objSignatureObject.ReplyMessageSignature = "AD Signature"
objDoc.Saved = True
objWord.Quit
Thank you
I currently have a main logon script that I want to add another script to, that creates an Outlook dynamic signature.
Can someone help me please with where and how to add it.
Script 1
Option Explicit
Dim oShell, oNet, oFSO, oWshNetwork, oGroupDict, oDrives, i
Dim objenv
Const USF = "HKCU\Software\Microsoft\Windows\Currentversion\Explorer\User Shell Folders\"
Const SF = "HKCU\Software\Microsoft\Windows\Currentversion\Explorer\Shell Folders\"
Const IE = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\"
'----------------- Objects---------------------------
Set oShell = CreateObject("Wscript.Shell")
Set oNet = CreateObject("Wscript.Network")
set oFSO = CreateObject("Scripting.FileSystemObject")
Set OBJENV = oshell.Environment("Process")
Set oDrives = oNet.EnumNetworkDrives
oShell.Run("net time \\bc-exeter-01 /set /y")
'----------------------------------------------------
'---------MAIN FUNCTION CALL SECTION-----------------
Greeting()
'removedrives
Mapdrives
mapprinters
'regsettings
'DisplayResources()
'oshell.run("net time \\bc-exeter-01 /set /y")
' oShell.Run "Net Time /DomainomainName /set /yes",0,False
' oShell.Run("net TIME \\bc-exeter-01 /set /y")
Displayloggedin
'-----------------END (FUNCTION CALLS)---------------
Sub Mapprinters
mapprinter "\\bc-exeter-01\Exeter_Contracts_Laser_A4",false
mapprinter "\\bc-exeter-01\Exeter_Contracts_Laser_A3",false
mapprinter "\\bc-exeter-01\Exeter_Contracts_Laser_Letterhead",false
mapprinter "\\bc-exeter-01\Exeter_Colour_Laser",false
mapprinter "\\bc-exeter-01\Exeter_Accounts_Laser",false
mapprinter "\\bc-exeter-01\Exeter_Plotter",false
mapprinter "\\bc-exeter-01\Exeter_Colour_A3",false
End Sub
sub removedrives
dim odrives,loop1
'run through all the current mapped drives and remove them
on error resume next
set odrives=onet.enumnetworkdrives
for loop1=0 to (odrives.count-1) step 2
if odrives(loop1) <> "" then onet.removenetworkdrive odrives(loop1),true
next
end sub
'-------------------
Sub Mapdrives()
DriveMapper "t:", "\\bc-exeter-02\estv5"
DriveMapper "w:", "\\bc-exeter-01\work"
DriveMapper "p:", "\\bc-plymouth\work"
DriveMapper "y:", "\\bc-yeovil\work"
end sub
'--------------------
'----------------------FUNCTIONS----------------------
Function Greeting()
Dim sTime, sDate, sMessage, sAdsPath, GreetingTime, oUser
sTime = Hour(Now)
sDate = Now
If sTime <= 11 Then
GreetingTime = "morning"
ElseIf sTime <= 18 Then
GreetingTime = "afternoon"
Else
GreetingTime = "evening"
End If
sMessage = VbCrLf & sDate & VbCrLf & VbCrLf
sMessage = sMessage & "Good " & GreetingTime & " " & oNet.UserName & ","
sMessage = sMessage & VbCrLf
smessage = smessage & "You are now being logged into the system..."
oshell.popup sMessage,2,"Welcome to the Network. Please keep it tidy!"
End Function
'-----------------
'map the drives
Function MapDrive(Drive, Share)
'The following line checks for the drives existance
'unfortunatly x: is a dfs directory and so it could not be found
'hence I have quoted it out.
'If oFSO.DriveExists(FileServer & Share) = True Then oNet.MapNetworkDrive Drive, FileServer & Share
oNet.MapNetworkDrive Drive, FileServer & Share
End Function
Sub DriveMapper(Drive, Share)
For i = 0 to oDrives.Count -1 Step 2
if LCase(Drive) = LCase(oDrives.Item(i)) then
if not LCase(Share) = LCase(oDrives.Item(i+1)) then
oNet.RemoveNetworkDrive Drive, true, true
Else
Exit Sub
End if
End if
Next
'oShell.Popup("Drive: " & drive & " Share:" & share)
oNet.MapNetworkDrive Drive, Share
End Sub
'-----------------
Function Displayloggedin()
dim msgstring
MsgString = "You have been logged in to this workstation..." & VBCRLF
oshell.popup MsgString,2,"Network Login Complete."
end function
'----------------------------------
Function IsMember(sGroup)
Dim sAdsPath, oUser, oGroup
If IsEmpty(oGroupDict) Then
Set oGroupDict = CreateObject("Scripting.Dictionary")
oGroupDict.CompareMode = vbTextCompare
sAdsPath = oNet.UserDomain & "/" & oNet.UserName
Set oUser = GetObject("WinNT://" & sAdsPath & ",user")
For Each oGroup In oUser.Groups
oGroupDict.Add oGroup.Name, "-"
Next
Set oUser = Nothing
End If
IsMember = CBool(oGroupDict.Exists(sGroup))
End Function
PRIVATE SUB MapPrinter(thepath,isitdefault)
oNet.AddWindowsPrinterConnection thepath
If isitdefault=True Then oNet.SetDefaultPrinter thepath
'WScript.Echo "Your printer is mapped from : " & thepath
end sub
Script 2
On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strTitle = objUser.Title
strCompany = objUser.company
strMail = objUser.Mail
strWeb = objuser.wwwhomepage
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objRange = objDoc.Range()
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
objSelection.Font.Size = "11"
objSelection.Font.Name = "Calibri"
objSelection.ParagraphFormat.SpaceAfter = 0
objSelection.TypeText CHR(11)
objSelection.TypeText "Kind Regards"
objSelection.TypeText CHR(11)
objSelection.TypeText CHR(11)
objSelection.Font.Bold = true
objSelection.TypeText strName & ", "
objSelection.Font.Bold = false
objSelection.TypeText CHR(11)
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
objSelection.TypeText CHR(11)
objSelection.Font.Bold = true
objSelection.TypeText "Beale and Cole - Building Services"
objSelection.Font.Bold = false
objSelection.TypeText CHR(11)
objSelection.TypeText "T: 01392 825960"
objSelection.TypeText CHR(11)
objSelection.TypeText "F: 01392 825961"
objSelection.TypeText CHR(11)
objSelection.TypeText "E: " & strMail
objSelection.TypeText CHR(11)
objSelection.Hyperlinks.Add objselection.range, strWeb
Set objSelection = objDoc.Range()
objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"
objSignatureObject.ReplyMessageSignature = "AD Signature"
objDoc.Saved = True
objWord.Quit
Thank you