Bonjour,
Je souhaite mettre en place une macro sous Outlook afin de remettre en forme une newsletter émanant de SharePoint pour pouvoir la retransmettre Í une liste de diffusion.
Cette macro aurait pour but de supprimer des éléments inutiles (logos Microsoft, Sharepoint et le bas de page "Obtenir l'application mobile SharePoint" et remplacer l'icone SharePoint par le logo identité visuelle de mon SharePoint.
Est-ce possible et si oui, comment ?
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
LaurentC
Bonjour Fabien Bien loin de ta demande, un bout de code qui traite les gif et jpeg dans un email ... peut être y trouveras tu un peu d'aide ou idée pour commencer ton code. HTH @+Laurent ' Macro qui bascule les PJ JPG et GIF dans le message Sub ImagesDansMessage() Dim leMess As MailItem Dim LItem As Object Dim LeDoss As MAPIFolder Dim lesItems As Items Dim laPJ As Attachment Dim nbAtt As Integer Dim i As Integer Set LeDoss = Session.GetDefaultFolder(olFolderInbox) Set lesItems = LeDoss.Items For Each LItem In lesItems If TypeName(LItem) = "MailItem" Then Set leMess = LItem If leMess.BodyFormat = olFormatHTML Then nbAtt = leMess.Attachments.Count For Each laPJ In leMess.Attachments If Right(LCase(laPJ.FileName), 4) = ".jpg" Or _ Right(LCase(laPJ.FileName), 4) = "jpeg" Or _ Right(LCase(laPJ.FileName), 4) = ".gif" Then laPJ.SaveAsFile "c:Pieces jointes" & laPJ.DisplayName ' *** attention dossier leMess.HTMLBody = "<IMG alt='' hspace=0 src='" & "c:PiecesJointes" & laPJ.DisplayName & "' alignºseline border=0><br>" & leMess.HTMLBody ' *** attention dossier End If Next For i = leMess.Attachments.Count To 1 Step -1 Set laPJ = leMess.Attachments.Item(i) If Right(LCase(laPJ.DisplayName), 4) = ".jpg" Or _ Right(LCase(laPJ.DisplayName), 4) = "jpeg" Or _ Right(LCase(laPJ.DisplayName), 4) = ".gif" Then laPJ.Delete End If Next leMess.Save End If End If Next End Sub 'Fin de macro
Bonjour Fabien
Bien loin de ta demande, un bout de code qui traite les gif et jpeg
dans un email ... peut être y trouveras tu un peu d'aide ou idée pour
commencer ton code.
HTH
@+Laurent
' Macro qui bascule les PJ JPG et GIF dans le message
Sub ImagesDansMessage()
Dim leMess As MailItem
Dim LItem As Object
Dim LeDoss As MAPIFolder
Dim lesItems As Items
Dim laPJ As Attachment
Dim nbAtt As Integer
Dim i As Integer
Set LeDoss = Session.GetDefaultFolder(olFolderInbox)
Set lesItems = LeDoss.Items
For Each LItem In lesItems
If TypeName(LItem) = "MailItem" Then
Set leMess = LItem
If leMess.BodyFormat = olFormatHTML Then
nbAtt = leMess.Attachments.Count
For Each laPJ In leMess.Attachments
If Right(LCase(laPJ.FileName), 4) = ".jpg" Or _
Right(LCase(laPJ.FileName), 4) = "jpeg" Or _
Right(LCase(laPJ.FileName), 4) = ".gif" Then
laPJ.SaveAsFile "c:Pieces jointes" & laPJ.DisplayName '
*** attention dossier
leMess.HTMLBody = "<IMG alt='' hspace=0 src='" &
"c:PiecesJointes" & laPJ.DisplayName & "' alignºseline
border=0><br>" & leMess.HTMLBody ' *** attention dossier
End If
Next
For i = leMess.Attachments.Count To 1 Step -1
Set laPJ = leMess.Attachments.Item(i)
If Right(LCase(laPJ.DisplayName), 4) = ".jpg" Or _
Right(LCase(laPJ.DisplayName), 4) = "jpeg" Or _
Right(LCase(laPJ.DisplayName), 4) = ".gif" Then
laPJ.Delete
End If
Next
leMess.Save
End If
End If
Next
Bonjour Fabien Bien loin de ta demande, un bout de code qui traite les gif et jpeg dans un email ... peut être y trouveras tu un peu d'aide ou idée pour commencer ton code. HTH @+Laurent ' Macro qui bascule les PJ JPG et GIF dans le message Sub ImagesDansMessage() Dim leMess As MailItem Dim LItem As Object Dim LeDoss As MAPIFolder Dim lesItems As Items Dim laPJ As Attachment Dim nbAtt As Integer Dim i As Integer Set LeDoss = Session.GetDefaultFolder(olFolderInbox) Set lesItems = LeDoss.Items For Each LItem In lesItems If TypeName(LItem) = "MailItem" Then Set leMess = LItem If leMess.BodyFormat = olFormatHTML Then nbAtt = leMess.Attachments.Count For Each laPJ In leMess.Attachments If Right(LCase(laPJ.FileName), 4) = ".jpg" Or _ Right(LCase(laPJ.FileName), 4) = "jpeg" Or _ Right(LCase(laPJ.FileName), 4) = ".gif" Then laPJ.SaveAsFile "c:Pieces jointes" & laPJ.DisplayName ' *** attention dossier leMess.HTMLBody = "<IMG alt='' hspace=0 src='" & "c:PiecesJointes" & laPJ.DisplayName & "' alignºseline border=0><br>" & leMess.HTMLBody ' *** attention dossier End If Next For i = leMess.Attachments.Count To 1 Step -1 Set laPJ = leMess.Attachments.Item(i) If Right(LCase(laPJ.DisplayName), 4) = ".jpg" Or _ Right(LCase(laPJ.DisplayName), 4) = "jpeg" Or _ Right(LCase(laPJ.DisplayName), 4) = ".gif" Then laPJ.Delete End If Next leMess.Save End If End If Next End Sub 'Fin de macro
