The email editor is Word 2003.
The company is undergoing a rebranding, so the logos and so on must be
removed (ideally replaced) and there is over 600 hundred .oft files to
process.
Public Sub Macro_RemoveImages()
Const PICTURE_TAG = "PICTURE (METAFILE)"
Dim olApp As New Outlook.Application
Dim mail As MailItem
Dim sourcePath As String
Dim targetPath As String
sourcePath = OpenFolderDialog(TEMPLATE_FOLDER, "Source folder:")
If sourcePath = "" Then Exit Sub
targetPath = OpenFolderDialog(TEMPLATE_FOLDER, "Target folder:")
If targetPath = "" Then Exit Sub
If UCase(targetPath) = UCase(sourcePath) Then
MsgBox "Source path and Target must be different", vbExclamation
Exit Sub
End If
Dim fso As Object, ofile As Object, folder As Object
Set fso = CreateFileSystemObject()
Dim i As Integer, c As Integer, savePath As String
Dim att As Attachment, atts() As Attachment
Set folder = fso.GetFolder(sourcePath)
For Each ofile In folder.Files
Debug.Print "*****************************"
Debug.Print "Loading " & ofile.name
Debug.Print "*****************************"
savePath = targetPath & "\" & ofile.name
Set mail = olApp.CreateItemFromTemplate(sourcePath & "\" & ofile.name)
If mail.Attachments.Count > 0 Then '<= Fails here
c = mail.Attachments.Count
ReDim atts(1 To c)
For i = 1 To c
Set att = mail.Attachments(i)
Debug.Print vbTab & "DisplayName: " & att.DisplayName
Debug.Print vbTab & "Type: " & att.Type
Debug.Print vbTab & "Position: " & att.Position
Debug.Print vbTab & "Index: " & att.Index
Debug.Print "---------------------------"
Set atts(i) = att
Next
For i = 1 To c
Set att = atts(i)
If UCase(att.DisplayName) = PICTURE_TAG Then
att.Delete
Debug.Print "Removed: " & i
End If
Next
End If
Debug.Print "Saving As " & savePath
mail.SaveAs savePath, OlSaveAsType.olTemplate
Set mail = Nothing
Next
End Sub
"Sue Mosher [MVP]" wrote:
> Also, please explain just what you mean by "mail templates." That could be a
> couple of different things in an Outlook context. And it might be helpful to
> know why you're doing this -- doesn't that render the templates less
> useful? -- and whether Word is your email editor.
> --
> Sue Mosher, Outlook MVP
> Author of Microsoft Outlook 2007 Programming:
> Jumpstart for Power Users and Administrators
> http://www.outlookcode.com/article.aspx?id=54
>
>
> "Ken Slovak - [MVP - Outlook]" <(E-Mail Removed)> wrote in message
> news:%(E-Mail Removed)...
> > Show the code you use.
> >
> > --
> > Ken Slovak
> > [MVP - Outlook]
> > http://www.slovaktech.com
> > Author: Professional Programming Outlook 2007.
> > Reminder Manager, Extended Reminders, Attachment Options.
> > http://www.slovaktech.com/products.htm
> >
> >
> > "chauwel" <(E-Mail Removed)> wrote in message
> > news:9A547081-CABD-4989-BC2B-(E-Mail Removed)...
> >> Outlook 2K3/Exchange
> >>
> >> I'm developping a macro to remove all embedded images from my company's
> >> mail
> >> templates, but although the templates actually contains images, the
> >> attachments collection remain empty at runtime. And the part that drive
> >> me
> >> crazy: in debug mode, the collection is empty (Count=0, etc) until I
> >> expand
> >> manually the "attachments" node of my mailitem object in the "Locals"
> >> window,
> >> then the collection is populated.
> >>
> >> The embbeded images are of type olOLE and there is no other attachment in
> >> the templates. Is that a bug or am i missing something ?
> >
>
>
> .
>
Similar Threads
