Lave signaturer med .vbs fra AD

I kan lige se her hvordan signaturen skal se ud nogenlunde...
http://img143.imageshack.us/img143/2852/expertenbillede1uu.jpg

FED TEKST:

kommandoen er      nyform.font.bold = true             

jeg har brugt den i følgende linier:
  set myform = nyefil.paragraphs(1).range

            myform.Text = now & "      "  & txt1
            myform.font.size = 10
            myform.font.italic = true
            myform.font.bold = true   


INDSÆTTE BILLEDER:  kommandoen er  'stwofil.Selection.InlineShapes.AddPicture "h:\documents\guldkorn\test.gif"  '

Jeg har en programstump som indsætter et billede i en wordfil, måske kan du bruge noget af det

call printprob_()



sub printprob_()
  on error resume next
      set stwofil = GetObject(, "Word.Application")
      if err.number > 0 then
        Call odoc.save (True, False)
        set stwofil = CreateObject ("Word.Application")
      end if
  err.clear
  on error goto 0
  Set nyefil = stwofil.Documents.Add("H:\Documents\Guldkorn\test.doc")
  nyefil.application.Visible = True
'stwofil.Selection.Text = "Hej Med Dig"
  stwofil.Selection.InlineShapes.AddPicture "h:\documents\guldkorn\test.gif"
'nyefil.printOut
'nyefil.application.quit
'nyefil.close
end sub

Det der er klasse nielsrs, jeg har prøvet at hjælpe sandahl i noget tid nu og har ikke kunne få det til at spille du kom lige med guldkornet der.. :D

strPicture = "Stien hen til dit billed"
objWord.Selection.InlineShapes.AddPicture strPincture

er det han skal bruge....

Jeg synes blot lige jeg ville sige takker til dig niels, jeg skal ikke have nogen point.. :D

Så er den sgu lavet...

her er hvad det blev til
____________
'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
strPhone = objUser.telephoneNumber
strEmail = objUser.mail
strLogo = "X:\netværkssti\2ch\logo.bmp"
strFirkant = "X:\netværkssti\firkant.bmp"

Set objWord = CreateObject("Word.Application")

objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries


'Font og størrelse/hilsen
objSelection.Font.Name = "Arial"
objSelection.Font.Size = "10"
Set objShape = objDoc.Shapes
objSelection.TypeText "Med venlig hilsen/Best regards"

'Navn og Titel
objSelection.TypeParagraph()
objSelection.Font.bold = true
objSelection.TypeText strName & " "
objSelection.Font.bold = false
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " " & strTitle

'Logo
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objWord.Selection.InlineShapes.AddPicture strLogo
objSelection.TypeParagraph()

'Phone, Mobile, og Fax
objSelection.TypeParagraph()
objSelection.TypeText "Phone +45 telefonnummer" & " "
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " Mobile +45 "
objSelection.TypeText strPhone & " "
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " "
objSelection.TypeText "Fax +45 telefonnummer"

'Email og webside
objSelection.TypeParagraph()
objSelection.TypeText strEmail & " "
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " www.site.com"

'Adresse
objSelection.TypeParagraph()
objSelection.TypeText "Headquaters "
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " adresse "
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " adresse"

'Byer
objSelection.TypeParagraph()
objSelection.TypeText "by "
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " by "
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " by "
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " by "
objWord.Selection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " By"

'Slogan
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Font.italic = true
objSelection.Font.bold = true
objSelection.TypeText "“SLOGAN!”"
objSelection.Font.italic = false
objSelection.Font.bold = false

'Sikkerhed
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Font.Size = "8"
objSelection.TypeText "CONFIDENTIALITY.TEKST."


Set objSelection = objDoc.Range()

objSignatureEntries.Add "Main signature ", objSelection
objSignatureObject.NewMessageSignature = "Main signature "


objDoc.Saved = True
objWord.Quit

wscript.echo "Din hoved signatur er nu lavet!"

'Kode lavet af mig
___________

Hvis den skal være helt perfekt så ville det være fedt hvis man kunne lave email og webside så man stadig kan klikke på dem, så de altså stadig er links, nogle der ved hvordan man laver det??

Altså det jeg leder efter nu, er hvordan man får strEmail fra useren til at stå som u-understreget, og sort... det der med understregningen tror jeg har klaret med objword.Selection.Font.Underline = false, har osse klaret det sorte...

Men hvad med links??

Måske noget i retning af
ActiveDocument.Shapes(1).LinkFormat.BreakLink

objSelection.Hyperlinks.Add objSelection.range, "mailto:" & strEmail, , , strEmail

Det var dette han gerne ville frem til.. :D
så laver den det om til mail link..

jep...

den gør det den skal, men den ignorere fuldstændigt de linier om hvad skrift type den skal skrive med, størrelser og farver, hvorfor nu det?

'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
strPhone = objUser.telephoneNumber
strEmail = objUser.mail
strLogo = "C:\Documents and Settings\azksaj1b\Dokumenter\Billeder\test.jpg"
strFirkant = "C:\Documents and Settings\azksaj1b\Dokumenter\Billeder\test.jpg"

Set objWord = CreateObject("Word.Application")

objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries


'Font og størrelse/hilsen
objSelection.Font.Name = "Arial"
objSelection.Font.Size = "9"
Set objShape = objDoc.Shapes
objSelection.TypeText "Med venlig hilsen/Best regards"

'Navn og Titel
objSelection.TypeParagraph()
objSelection.Font.bold = true
objSelection.TypeText strName & " "
objSelection.Font.bold = false
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " " & strTitle

'Logo
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.InlineShapes.AddPicture strLogo
objSelection.TypeParagraph()

'Phone, Mobile, og Fax
objSelection.TypeParagraph()
objSelection.TypeText "Phone +45 telefonnummer" & " "
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " Mobile +45 "
objSelection.TypeText strPhone & " "
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " "
objSelection.TypeText "Fax +45 telefonnummer"

'Email og webside
objSelection.TypeParagraph()
'objSelection.TypeText strEmail & " "
objSelection.Hyperlinks.Add objSelection.range, "mailto:" & strEmail, , , strEmail
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " www.site.com"

'Adresse
objSelection.TypeParagraph()
objSelection.TypeText "Headquaters "
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " adresse "
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " adresse"

'Byer
objSelection.TypeParagraph()
objSelection.TypeText "by "
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " by "
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " by "
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " by "
objSelection.InlineShapes.AddPicture strFirkant
objSelection.TypeText " By"

'Slogan
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Font.italic = true
objSelection.Font.bold = true
objSelection.TypeText "“SLOGAN!”"
objSelection.Font.italic = false
objSelection.Font.bold = false

'Sikkerhed
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Font.Size = "8"
objSelection.TypeText "CONFIDENTIALITY.TEKST."


Set objSelection = objDoc.Range()

objSignatureEntries.Add "Main signature ", objSelection
objSignatureObject.NewMessageSignature = "Main signature "


objDoc.Saved = True
objWord.Quit



Har tilladt mig at rette lidt i det da jeg kan se det jeg lavede var noget hø.. ha ha... jeg havde ikke lige lagt mærke til objselection var en variabel som indeholdt, objWord.Selection
jeg beklager.. men det skulle være rettet i denne her.. :D
Hvad mener du med at den ignorere skriftstørrelser og type... ? jeg har testet her godt nok hyperlinket er skrevet med noget andet men det andet er skrevet rigtig nok...?

Nå, jeg lukker det, de sidste problemer jeg har med det, har jeg sat nogle eksterne konsulenter til at ordne.

Hej,

Fik du nogen sinde løst dit hyperlinks formaterings issue? Hvis du gjorde ville det glæde mig meget hvis du kunne pege mig i den rigtige retning.
Se opgave: http://www.eksperten.dk/spm/771539

/nestle

hejsa!

Ja det gjorde jeg, men da vi brugte en del penge på at få det løst, så vælger jeg ikke at skrive det... jeg håber at du forstår.

helt ok, jeg fandt en løsning (med lidt hjælp)

Hvordan virker det så?

Hvor skal der VBS stå henne? Skal det integreres i mailen, eller er det et seperat script?

Jeg kunne godt tænke mig at se det i funktion nemlig...

Jeg har også to problemer.

1. Når jeg køre et vbs script i stilen med dette, får jeg min .normal med i bunden. kan dette omgåes på nogen måde.

2. Min office 2003 siger at word ikke findes eller ikke er i det rigtige format.

----------------

'Mail Signatur
'Nova C - 97 51 44 51
'Brian Kudsk

On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

'Variabler fra ad laves
strFirstName = objUser.FirstName
strLastName = objUser.LastName
strTitle = objUser.Title
strPhone = objUser.telephoneNumber
strMobile = objUser.mobile
strFax = objuser.FaxNumber
strEmail = objUser.mail

Set objWord = CreateObject("Word.Application")
objWord.Visible = true
pause
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

'Dette kan give en fejl hvis du mangler oplysnigner se de næste 3 linier
'If strMobile = "" Then
'wscript.echo "Du mangler Mobil nr.!"
'End If

'Font på hilsen og navn
objSelection.Font.Name = "Verdana"
objSelection.Font.Size = "12"
objSelection.Font.Italic = False
objSelection.Font.Bold = False
objSelection.TypeText "Med venlig hilsen"
objSelection.TypeParagraph()

objSelection.Font.Size = "7,5"
objSelection.TypeText "Best regards" & Chr(11)
objSelection.Font.Size = "12"
If strFirstName <> "" Then
objSelection.TypeText strFirstName & " " & strLastName & Chr(11)
End If

Set objSelection = objDoc.Range()

objSignatureEntries.Add "Standart Signatur", objSelection
objSignatureObject.NewMessageSignature = "Standart Signatur"
'objSignatureObject.ReplyMessageSignature = "Standart Signatur"

objDoc.Saved = True
objWord.Quit

Det er generalt en god skik at spørge om lov til at bruge et script, før man bruger det.

Der er jo en del der er kopieret fra mit. Men skidt pyt. Du kan finde hjælp ved sysinternals på the Script center repository.

Det skal jeg huske, undskyld.

Men jeg kan ikke rigtig finde et svar der inde.

Dit problem 2. kan være fordi dit script skal kunne styre om word er startet eller ej, dette kan løses ved at erstatte


Set objWord = CreateObject("Word.Application")

med

  on error resume next                             
  set objWord = GetObject(, "Word.Application")     
  if err.number > 0 then                                           
      set objWord = CreateObject ("Word.Application")
  end if                                           
  err.clear                                         
  on error goto 0

Microsoft har vist også stjålet dit script uden at spørge? men der er meget hjælp at hente hvis du kigger her: http://www.microsoft.com/technet/scriptcenter/default.mspx
eller her: http://technet.microsoft.com/en-us/magazine/cc160913(TechNet.10).aspx

serverkudsk: Man kan så sige at det ikke er pænt at bruge en andens opgave uden at spørge om lov, så måske du skulle oprette din egen?

Det har jeg også gjort.

http://www.eksperten.dk/spm/836082

Nej jeg har mit basis script fra MS, men jeg har lavet en del mere på det...

osse derfor jeg sagde at han kunne finde hjælp, selvsamme sted jeg har det fra...

JEg har lavet nogle rigtig gode scripts til ovenstående, dog har jeg et lille problem er der nogen af jer der ved hvordan jeg laver tabulator funktionen. Forstået således at min tekst i dag står som nedenstående:

Direkte:  +45 12 34 56 78
Mobil:    +45 12 34 56 78

Jeg vil gerne bruge tab til at få det til at stå således
Direkte:  +45 12 34 56 78
Mobil:    +45 12 34 56 78

For det kan bare ikke lade sig gøre i outlook at få til at stå helt lige med space, any ideas ?

Kan se de jeg har skrevet så også fejlet, det jeg mener er at de 2 numre skal står lige under hinanden... Ja, tror i ved hvad jeg mener.

prøv med vbtab

Anden Container end users eks Firma A/S - Brugere
Hvordan sætter jeg det ind i Set objUser = GetObject("LDAP://" & strUser) ?

Sæt LDAP stien ind for den OU de ligger i, vil jeg tro.

Hvor tjecker jeg hvad LDAP stien er ?

Den ligger under DOMAIN -> FIRMA A/S -> Brugere