On error Resume Next

'Przygotowanie zmiennych wykorzystanych w skrypcie
'zmienie str* okreslają stałe dane firmy wyświetlane w każdej stopce

errsig   = False      
'zmienna test określa czy w stopce powinny pojawiać się rozszerzone informacje o przedsiębiorstwie
tst      = 1
strInfo  = "Pozdrawiam / Mit freundlichen Grüßen / Best Regards / Cordialement"
strWWW1  = "www.wss-test.pl"
strWWW2  = "www.wss-test.pl"
strCom1  = "Windows Server System"
strAdr1  = "ul. Serwerowa 1"
strAdr2  = "00-000 Microsoft"
strInf1  = "NIP: PL XXX"
strInf2  = "Sąd Rejonowy w XXX XX Wydział Gospodarczy Krajowego Rejestru Sądowego"
strInf3  = "Numer KRS: XXX"
strInf4  = "Wysokość kapitału zakładowego: XXX PLN"


'odczytanie danych o komputerze i użytkowniku z domeny lub z komputera lokalnego
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
strCmp = objSysInfo.ComputerName

if ( (Len(strUser) = 0) or (Len(strCmp) = 0) ) Then 
  Set objNetwork = CreateObject("Wscript.Network")
  strUser = objNetwork.UserName
  strCmp = objNetwork.ComputerName  
  if ( (Len(strUser) = 0) or (Len(strCmp) = 0) ) Then 
    Set wshShell = WScript.CreateObject( "WScript.Shell" )
    strCmp = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
    strUser = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
    if ( (Len(strUser) = 0) or (Len(strCmp) = 0) ) Then 
      errsig = True	
	End If
  end if
End if


'Określienie wersji aplikacji Microsoft Outlook
Set OutApp = CreateObject("Outlook.Application")
If OutApp.Version = "9.0.0.2711" or  OutApp.Version = "9.0.0.3011" or OutApp.Version = "9.0.0.3821" or OutApp.Version = "9.0.0.4105" or OutApp.Version = "9.0.0.4201" or OutApp.Version = "9.0.0.4527" or OutApp.Version = "9.0.0.5414" Then
   OldApp = True
   Set wshShell = WScript.CreateObject("WScript.Shell" )
   StrPro = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")+"\Application Data\Microsoft\Signatures\"
Else 
  OldApp = False
End If


'Definicja struktur danych potrzebnych do działania skryptu
Class userData
  dim compName
  dim name
  dim dep
  dim tel
  dim fax
  dim email
  dim mobile 
end class

class othersUsers
'Definicja wielkości tablicy do przechowywania danych o podpisach
  dim users(60,6)
  dim pos
  dim max
  Private Sub Class_Initialize
    pos = 0 
    max = 60
  End Sub

  Private Sub Class_Terminate
  End Sub

  Function AddCmp(inCompName, inName, inDep, inTel, inFax, inEmail, inMobile)
    users(pos,0) = inCompName
    users(pos,1) = inName
    users(pos,2) = inDep
    users(pos,3) = inTel
    users(pos,4) = inFax
    users(pos,5) = inEmail
    users(pos,6) = inMobile
    pos = pos + 1
	AddCmp = True
  end Function

  Function GetUser(inCompName, outName, outDep, outTel, outFax, outEmail, outMobile)
    res = False
    outName   = ""
    outDep    = ""
    outTel    = ""
    outFax    = ""
    outEmail  = ""
    outMobile = ""

    for i=0 to max-1

      if ( lcase(inCompName) = lcase(users(i,0)) ) then
        outName   = users(i,1)
        outDep    = users(i,2)
        outTel    = users(i,3)
        outFax    = users(i,4) 
        outEmail  = users(i,5)
        outMobile = users(i,6)
        res = True
      end if
    next
    GetUser = res
  end Function
end class

'Dane o użytkownikach dla których zostały zdefiniowane stopki
if ( errsig = false ) then
  'Określenie komputerów/użytkowników którzy korzystają z informacji zapisanych w właściwościah użytkownika z domeny
  if ((strUser <> "jnowak") and (lcase(strUser) <> lcase("CN=ksiegowa,OU=Ksiegowosc,OU=WSS,DC=wss-test,DC=net"))) then
    Set objUser = GetObject("LDAP://" & strUser)
    strName    = objUser.FirstName & " " & objUser.LastName
    strDep     = objUser.Department
    strTel     = objUser.telephoneNumber
    strFax     = objUser.faxNumber
    strEmail   = objUser.EmailAddress
    strMobile  = objUser.TelephoneMobile
  else
    set oUsers = new othersUsers
	'Księgowość
    'określenie danych do stopki dla komputerów/uzytkowników którzy nie korzystają z domeny lub pracują przy wykorzystaniu jednego konta
    tst = oUsers.AddCmp("CN=WSS-CLI1,OU=Ksiegowosc,OU=WSS,DC=wss-test,DC=net","Wojtek Kowalski","Księgowość","+48 xxx xxxxxxx","+48 xxx xxxxxxx","w.kowalski@wss.pl","")
    tst = oUsers.AddCmp("CN=WSS-CLI2,OU=Ksiegowosc,OU=WSS,DC=wss-test,DC=net","Agnieszka Nowak","Księgowość","+48 xxx xxxxxxx","+48 xxx xxxxxxx","a.nowak@wss.pl","")
    tst = oUsers.AddCmp("WSS-CLI3","Jan Nowak","Księgowość","+48 xxx xxxxxxx","+48 xxx xxxxxxx","j.nowak@wss.pl","")
   
    errsig = not(oUsers.GetUser(strCmp, strName, strDep, strTel, strFax, strEmail, strMobile))

  end if
end if

'Informacja w stopce w przypadku wystąpienia błędu np. brak informacji o użytkowniku
if errsig then
  strName   = "Uwaga!!! Wystąpił problem z instalowaniem podpisu, Skontaktuj się proszę z administratorem"
  strDep    = ""
  strTel    = ""
  strFax    = ""
  strEmail  = ""
  strMobile = ""
end if

'Formatowanie i budowa stopki maila
Set objWord = CreateObject("Word.Application")
objWord.Visible = False
'objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

objSelection.Font.Name = "AvantGarde Bk BT"
objSelection.Font.Size = "10"

if ( errsig ) then 
  objSelection.Font.Color = RGB(227,55,255)
  objSelection.Font.Bold = True 
else
  objSelection.Font.Color = RGB(77,77,77)
end if

if Len(strInfo) > 0 Then 
  objSelection.TypeText strInfo & Chr(11)
End if

objSelection.Font.Name = "AvantGarde Bk BT"
objSelection.Font.Size = "11"

if Len(strName) > 0 Then 
 objSelection.TypeText strName  & Chr(11)
end if

objSelection.Font.Name = "AvantGarde Bk BT"
objSelection.Font.Size = "8"

if Len(strDep) > 0 Then 
  objSelection.TypeText strDep & vbTab  & Chr(11)
end if

objselection.ParagraphFormat.TabStops.ClearAll 
objSelection.ParagraphFormat.TabStops.Add objWord.InchesToPoints(0.38) 

if Len(strTel) > 0 Then 
  objSelection.TypeText "Fon" & vbTab & strTel  & Chr(11)
end if

if Len(strFax) > 0 Then 
  objSelection.TypeText "Fax" & vbTab & strFax & Chr(11)
end if

if Len(strMobile) > 0 Then 
  objSelection.TypeText "Mobile" & vbTab & strMobile & Chr(11)
end if

if Len(strEmail) > 0 Then 
  objSelection.TypeText "Mail" & vbTab
  objSelection.TypeText strEmail & Chr(11)
end if

if Len(strCom1) > 0 Then 
  objSelection.TypeText strCom1 & Chr(11)
end if

objselection.ParagraphFormat.TabStops.ClearAll 
objSelection.ParagraphFormat.TabStops.Add objWord.InchesToPoints(0.38) 

if Len(strAdr1) > 0 Then 
  objSelection.TypeText vbTab & strAdr1 & Chr(11)
end if

if Len(strAdr2) > 0 Then 
  objSelection.TypeText vbTab & strAdr2 & Chr(11)
end if

if Len(strWWW1) > 0 Then 
  objSelection.TypeText vbTab & strWWW1 & Chr(11)
end if

if Len(strWWW2) > 0 Then 
  objSelection.TypeText vbTab & strWWW2 & Chr(11)
end if

Set objShape = objSelection.InlineShapes.AddPicture("\\wss\post_sign$\logo.jpg")
objSelection.TypeText Chr(11)

objselection.ParagraphFormat.TabStops.ClearAll 

if ( tst = 0 ) Then

  if Len(strInf2) > 0 Then 
    objSelection.TypeText strInf2 & Chr(11)
  end if

  if Len(strInf3) > 0 Then 
    objSelection.TypeText strInf3 & Chr(11)
  end if

  if Len(strInf1) > 0 Then 
    objSelection.TypeText strInf1 & Chr(11)
  end if

  if Len(strInf4) > 0 Then 
    objSelection.TypeText strInf4 & Chr(11)
  end if
end if
objSelection.TypeParagraph()

    Set objSelection = objDoc.Range()
    With objSelection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .Alignment = wdAlignParagraphLeft
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
    End With
	
'Ustawienie podpisu
if ( not OldApp ) Then
  Set objSelection = objDoc.Range()
  Set objEmailOptions = objWord.EmailOptions
  Set objSignatureObject = objEmailOptions.EmailSignature
  Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

  objSignatureEntries.Add "WSS Post-Sign", objSelection
  objSignatureObject.NewMessageSignature = "WSS Post-Sign"
  objSignatureObject.ReplyMessageSignature = "WSS Post-Sign"
else
  objDoc.SaveAs strPro & "Default.rtf", RTF
  objDoc.SaveAs strPro & "Default.txt", Text
  objDoc.SaveAs strPro & "Default.htm", HTML
end if
objDoc.Saved = True
objWord.Quit