A
Aline
Hello!
I want to print only the attachments from my list of
messages and here is my code, where myItem is the message:
myItem.PrintOut Attachments:=1
It worked once but now is not working anymore.
Here you have the complete code:
Sub PrintAtt()
On Error Resume Next
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As
Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim v As Integer
'MsgBox "SVP selectionner les items."
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
MsgBox "Il y a " & myOlSel.Count & " messages
dans le dossier."
'for all items do...
For Each myItem In myOlSel
'point on attachments
Set myAttachments = myItem.Attachments
'if there are some...
If myAttachments.Count > 0 Then
'for all attachments do...
For i = 1 To myAttachments.Count
'remove it (use this method in Outlook
XP)'add remark to message text
If Right(myAttachments(i).FileName, 3) = "doc"
Or Right(myAttachments(i).FileName, 3) = "pdf" Or _
Right(myAttachments(i).FileName, 3)
= "dot" Or Right(myAttachments(i).FileName, 3) = "rtf" Or _
Right(myAttachments(i).FileName, 3)
= "tif" Then
'myAttachments.Item1.FileName.PrintOut
myItem.PrintOut Attachments:=1
'myItem.Delete
v = v + 1
End If
Next i
End If
Next
If v > 1 Then
MsgBox "Les " & v & " fichiers ont été imprimés."
Else
If v = 1 Then
MsgBox "Un fichier a été imprimé."
Else
MsgBox "Votre boîte Outlook ne contient pas de
fichiers à imprimer."
End If
End If
'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
Thanks for any help
I want to print only the attachments from my list of
messages and here is my code, where myItem is the message:
myItem.PrintOut Attachments:=1
It worked once but now is not working anymore.
Here you have the complete code:
Sub PrintAtt()
On Error Resume Next
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As
Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim v As Integer
'MsgBox "SVP selectionner les items."
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
MsgBox "Il y a " & myOlSel.Count & " messages
dans le dossier."
'for all items do...
For Each myItem In myOlSel
'point on attachments
Set myAttachments = myItem.Attachments
'if there are some...
If myAttachments.Count > 0 Then
'for all attachments do...
For i = 1 To myAttachments.Count
'remove it (use this method in Outlook
XP)'add remark to message text
If Right(myAttachments(i).FileName, 3) = "doc"
Or Right(myAttachments(i).FileName, 3) = "pdf" Or _
Right(myAttachments(i).FileName, 3)
= "dot" Or Right(myAttachments(i).FileName, 3) = "rtf" Or _
Right(myAttachments(i).FileName, 3)
= "tif" Then
'myAttachments.Item1.FileName.PrintOut
myItem.PrintOut Attachments:=1
'myItem.Delete
v = v + 1
End If
Next i
End If
Next
If v > 1 Then
MsgBox "Les " & v & " fichiers ont été imprimés."
Else
If v = 1 Then
MsgBox "Un fichier a été imprimé."
Else
MsgBox "Votre boîte Outlook ne contient pas de
fichiers à imprimer."
End If
End If
'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
Thanks for any help