none
Imagem na Assinatura Aleatório RRS feed

 > 

  • Pergunta

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Boas Pessoal,

    Alguém já precisou criar um script que colocasse na assinatura do Outlook uma imagem aleatória de um conjunto de imagens em uma pasta?

    Existe um script que cria assinaturas baseada na info colocada nos Atributos Ldap na AD (vide em http://lab.technet.microsoft.com/en-us/magazine/cc160913), o mesmo pode adicionar uma imagem. O pretendido seria adicionar uma imagem aleatória de uma grupo delas.

    O melhor que consegui encontrar na net foi neste site http://www.nangets.net/?p=151 mas que cria aleatóriamente textos. Ele coloca o código no Editor de VB do Outlook e cada vez que é aberta uma mensagem e enviada um texto diferente é enviado.

    Alguém sabe como fazer ou tenha feito algo parecido?

    Cláudio Gonçalves
    segunda-feira, 1 de agosto de 2011 15:50
    |

Respostas

  • Question
    Entrar para Votar
    0
    Entrar para Votar 
    Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

 ' Validate that the item sent is an email.

 If Item.Class <> olMail Then Exit Sub



 Const SearchString = "%Random_Line%"

 Const QuotesFile = "C:\Users\Administrator\Desktop\quotes.txt"

 MsgBox ("Passo1")

 If InStr(Item.Body, SearchString) Then

  If FileOrDirExists(QuotesFile) = False Then

   MsgBox ("Quotes file wasn't found! Canceling message")

   Cancel = True

  Else

   Dim lines() As String

   Dim numLines As Integer

   numLines = 0



   ' Open the file for reading

   Open QuotesFile For Input As #1

   MsgBox ("Passo2")



   ' Go over each line in the file and save it in the array + count it

   Do Until EOF(1)

    ReDim Preserve lines(numLines + 1)

    Line Input #1, lines(numLines)

    numLines = numLines + 1

   Loop

   MsgBox ("Passo3")

   Close #1



   ' Get the random line number

   Dim randLine As Integer

   randLine = Int(numLines * Rnd()) + 1

   ' Insert the random quote

   Item.HTMLBody = Replace(Item.HTMLBody, SearchString, "<img src=""http://servidor/" & lines(randLine) & " ""/>")

   MsgBox ("<img src=""http://servidor/" & lines(randLine) & " ""/>")

   Item.HTMLBody = Replace(Item.HTMLBody, "%Random_Num%", "<img src=""http://servidor/" & randLine & " ""/>")

   MsgBox ("<img src=""http://servidor/" & randLine & " ""/>")

  End If

 End If

End Sub



Function FileOrDirExists(PathName As String)

 Dim iTemp As Integer



 On Error Resume Next

 iTemp = GetAttr(PathName)



 Select Case Err.Number

 Case Is = 0

  FileOrDirExists = True

  MsgBox ("Passo4")

 Case Else

  FileOrDirExists = False

  MsgBox ("Passo5")

 End Select



 On Error GoTo 0

End Function


    segue o codigo todo...

    Lembrando nao funcionou em 2007...:(

    Abraços...

     

    Edson Matias Fagundes Junior (Nioks)
    terça-feira, 2 de agosto de 2011 20:32
    |

Todas as Respostas

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Boa tarde Cláudio, não consegui fazer testes mas veja se lhe ajuda ok.

    http://www.brettb.com/RandomImageSelector.asp

     Abraços.

    Edson Matias Fagundes Junior (Nioks)

    segunda-feira, 1 de agosto de 2011 17:31
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Claudio achei legal sua pergunta e util dai resolvi aplicar ao meu abiente segue modelo de script que uso para aplicar assinatura automaticamente e agora com image rand.

     

     

    'Declare variables

Dim CompleteImagesFolderPath
Dim FileSystemObject
Dim ImageFolder
Dim Files
Dim i
Dim ImageFiles
Dim File
Dim FileName
Dim FileExtension
Dim RandomNumber


'Find the complete path to image folder by using Server.MapPath
CompleteImagesFolderPath = "C:\Users\Public\Pictures\Sample Pictures\"

'Create an instance of the FileSystemObject which allows ASP to
'access the file system 
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

'Check that the folder containing the images exists
If Not FileSystemObject.FolderExists(CompleteImagesFolderPath) Then
RandomImage = "Error 0: Cannot find requested folder"
Set FileSystemObject = nothing
'Exit Function
End If

'Get the folder containing the images
Set ImageFolder = FileSystemObject.GetFolder(CompleteImagesFolderPath)

'Get a list of all the files within the images folder
Set Files = ImageFolder.Files

'Use a dictionary object to temporarily store the image file names
i = 1
Set ImageFiles = CreateObject("Scripting.Dictionary")

'Loop through the list of files within the images folder.
'If the file has a file extension that is in the list of
'file types specified in the ImageFileTypes function parameter,
'then add the file name to the ImageFiles dictionary object
For Each File in Files

FileName = File.Name
ImageFiles.Add i, FileName
i = i + 1

Next

'Destroy objects that are no longer required
Set ImageFolder = nothing
Set Files = nothing
Set FileSystemObject = nothing

'Initialise the random number generator
Randomize

' Check that image file(s) have been found
If ImageFiles.Count = 0 Then
RandomImage = "Error 1: Requested folder does not contain any image files"
'Exit Function
End If

'Generate a random number between 1 and the number of image files
RandomNumber = Int((ImageFiles.Count) * Rnd + 1)

'Return a hyperlink to a random image file
RandomImage = ImageFiles.Item(RandomNumber)
Set ImageFiles = nothing

'*******************************************FIM FUNÇÃO RANDON**********************************************

Const END_OF_STORY = 6
Const wdFormatHTML = 8

On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
With objUser
 strName = .FullName
 strTitle = .Description
End With

strCompany = objUser.Company
strl = objUser.l
strco = objUser.co
strPhone = objUser.TelephoneNumber
strFax = objUser.facsimileTelephoneNumber
strMobile = objUser.Mobile
strWeb = objuser.wWWHomePage
strUserName = objuser.sAMAccountName

Set objword = CreateObject("Word.Application")
With objword

 Set objDoc = .Documents.Add()
 Set objSelection = .Selection
 Set objEmailOptions = .EmailOptions
 
 Set objRange = objDoc.Range()
 objDoc.Tables.Add objRange,1,2
 Set objTable = objDoc.Tables(1)

End With

Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
MsgBox (http://servidor/& RandomImage)
With objSelection

objTable.Rows.Add()
  
  objTable.Cell(2, 1).Range.InlineShapes.AddPicture "http://servidor/"&RandomImage,true,True
  objTable.Columns(1).Width = objWord.InchesToPoints(1)

 objTable.Cell(2, 2).Select
  With .Font
 .Name = "Verdana"
 .Size = 10
 .Bold = True
 .Color = 0
  End With
 .TypeText strName & Chr(11)
 '.TypeParagraph()

 With .Font
 .Name = "Verdana"
 .Size = 8
 .Bold = False
 .Italic = False
 .Color = 0
 End With
 .TypeText strTitle & Chr(11) & "Tel. " & strPhone & Chr(11) & "Cel. " & strMobile & Chr(11) & "Fax. " & strFax & Chr(11) & "Site. " & strWeb & Chr(11)
 '.TypeParagraph()
 
 objTable.Columns(2).Width = objWord.inchesToPoints(0) 

objSelection.EndKey END_OF_STORY 

 objSelection.Font.Name = "Verdana"
 objSelection.Font.Size = "8"
 objSelection.Font.italic = true
 objSelection.Font.Color = Black
 objSelection.Font.Bold = False 
 objSelection.TypeText "Esta mensagem e seus anexos são confidenciais e talvez privilegiados. Se você não é o destinatário, por favor notifique o remetente imediatamente e não divulgue o conteúdo para terceiros, tampouco use para outros propósitos ou armazene tais informações."
 .TypeText Chr(11)
 .TypeText Chr(11)
 objSelection.Font.italic = true
 objSelection.Font.Color = 240240 
 objSelection.Font.Bold = False 
 objSelection.TypeText "* PENSE NA NATUREZA ANTES DE IMPRIMIR."


 End With



Set objSelection = objDoc.Range()
objSignatureEntries.Add "Padrao Leonardi", objSelection
objSignatureObject.NewMessageSignature = "Padrao Leonardi"
objSignatureObject.ReplyMessageSignature = "Padrao Leonardi"
objDoc.SaveAs "\\servidor\sys\assinaturas\" & strUserName & ".htm", wdFormatHTML
objDoc.Saved = True
objword.Quit
    Abraços

     

    Edson Matias Fagundes Junior (Nioks)
    segunda-feira, 1 de agosto de 2011 19:32
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Edson, o seu Script funciona bem e muito obrigado pela ajuda, mas tem um senão.

    Da forma como está, precisará ser colocado como Logon Script correcto?

    Para o pretendido a imagem aleatória precisa ser a cada envio de e-mail e não a cada logon. Com usuários de laptops poderá ficar complicado. Um dos motivos de ter colocado este link  http://www.nangets.net/?p=151, é que o cara introduz o código na sessão do Outlook via a Tab Developer, depois adicionar uma variavel no texto do email o que achei bastante funcional.

    Não sei programar de raiz, gerlamente adapto os códigos às minhas necessidades, por isso peço ajuda :-)

    É possível adaptar o seu código para ser usado como nesse link desse cara?

    Cláudio Gonçalves
    terça-feira, 2 de agosto de 2011 08:16
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Cláudio, desculpe... eu realmente apliquei ao meu ambiente...

    Vou verificar se consigo lhe ajudar ok...

    Abraços

     

    Edson Matias Fagundes Junior (Nioks)
    terça-feira, 2 de agosto de 2011 12:55
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar
    Cara nao consegui fazer funcionar em office 2007... deu certo no seu????
    Edson Matias Fagundes Junior (Nioks)
    terça-feira, 2 de agosto de 2011 13:53
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Estás a falar do código para colocar no Developer?

    Eu estou a usar o Office 2010 e correr sem problemas.

    Gravei antes de fechar a sessão e coloquei a variavél sem problemas.

    no ficheiro de texto é importante dar ENTER para separar as linhas.

    Cláudio Gonçalves
    terça-feira, 2 de agosto de 2011 14:19
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Vamos lá... consultando esse codigo que voce mandou como exemplo eu criei um arquivo com uma lista de arquivos que tenho publicado na internet... as tais imagens...

    Alterei o script do colega para +/- atender sua necessidade ou para atender...
    Como no proprio exemplo ele tem que colocar o %Random_Line%
    Alterei essa parte do codigo aqui funcionou se voque quiser mando o codigo todo mas nao acho necessario pois coloquei um monte de ponto de verificação...
    rsrssrs...

    Posso dizer que deu um trabalhinho mas valeu apena.

    Abraços


                ' Insert the random quote
                Item.HTMLBody = Replace(Item.HTMLBody, SearchString, "<img src=""http://servidor/" & lines(randLine) & " ""/>")
               ' MsgBox ("<img src=""http://servidor/" & lines(randLine) & " ""/>")
                Item.HTMLBody = Replace(Item.HTMLBody, "%Random_Num%", "<img src=""http://servidor/" & randLine & " ""/>")
                'MsgBox ("<img src=""http://servidor/" & randLine & " ""/>")
            End If

     

    Edson Matias Fagundes Junior (Nioks)

    terça-feira, 2 de agosto de 2011 20:05
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar 
    Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

 ' Validate that the item sent is an email.

 If Item.Class <> olMail Then Exit Sub



 Const SearchString = "%Random_Line%"

 Const QuotesFile = "C:\Users\Administrator\Desktop\quotes.txt"

 MsgBox ("Passo1")

 If InStr(Item.Body, SearchString) Then

  If FileOrDirExists(QuotesFile) = False Then

   MsgBox ("Quotes file wasn't found! Canceling message")

   Cancel = True

  Else

   Dim lines() As String

   Dim numLines As Integer

   numLines = 0



   ' Open the file for reading

   Open QuotesFile For Input As #1

   MsgBox ("Passo2")



   ' Go over each line in the file and save it in the array + count it

   Do Until EOF(1)

    ReDim Preserve lines(numLines + 1)

    Line Input #1, lines(numLines)

    numLines = numLines + 1

   Loop

   MsgBox ("Passo3")

   Close #1



   ' Get the random line number

   Dim randLine As Integer

   randLine = Int(numLines * Rnd()) + 1

   ' Insert the random quote

   Item.HTMLBody = Replace(Item.HTMLBody, SearchString, "<img src=""http://servidor/" & lines(randLine) & " ""/>")

   MsgBox ("<img src=""http://servidor/" & lines(randLine) & " ""/>")

   Item.HTMLBody = Replace(Item.HTMLBody, "%Random_Num%", "<img src=""http://servidor/" & randLine & " ""/>")

   MsgBox ("<img src=""http://servidor/" & randLine & " ""/>")

  End If

 End If

End Sub



Function FileOrDirExists(PathName As String)

 Dim iTemp As Integer



 On Error Resume Next

 iTemp = GetAttr(PathName)



 Select Case Err.Number

 Case Is = 0

  FileOrDirExists = True

  MsgBox ("Passo4")

 Case Else

  FileOrDirExists = False

  MsgBox ("Passo5")

 End Select



 On Error GoTo 0

End Function


    segue o codigo todo...

    Lembrando nao funcionou em 2007...:(

    Abraços...

     

    Edson Matias Fagundes Junior (Nioks)
    terça-feira, 2 de agosto de 2011 20:32
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Edson,

    pelos meus testes iniciais parece corresponder ao que preciso.

    Pelo que entendi as imagens ficam publicadas na net e no ficheiro de texto está a lista dos ficheiros.

    Amanhã farei testes mais profundos e irei postar.

    Vou tentar adaptar.

    Mas valeu muiitoo, acho que muita gente irá gostar.

    Cláudio Gonçalves
    terça-feira, 2 de agosto de 2011 20:54
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Fico Feliz por ajudar nao equece de colocar o nome dos arquivos completo imagem.jpg no txt ok.

     

    Abraços...

     

    Edson Matias Fagundes Junior (Nioks)
    terça-feira, 2 de agosto de 2011 21:00
    |