Attachments collection bug ?

[chauwel]

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 ?

 

[Ken Slovak - [MVP - Outlook]]

Show the code you use.

 

[Sue Mosher [MVP]]

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

 

[chauwel]

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

 

[Ken Slovak - [MVP - Outlook]]

I have no idea why it's failing on this line:

If mail.Attachments.Count > 0 Then '<= Fails here

However, try instantiating an Attachments collection first:

Dim colAttach As Outlook.Attachments
Set colAttach = mail.Attachments
c = colAttach.Count
If c > 0 Then

 

[Sue Mosher [MVP]]

That does seem odd. You might want to try saving the item before attempting
to access its Attachments collection.

Alternatively, go through Inspector.WordEditor to work with the
Word.Document that forms the body of the message.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54