|
|
| (2 dazwischenliegende Versionen desselben Benutzers werden nicht angezeigt) |
| Zeile 1: |
Zeile 1: |
| − | {{BenutzerSeitenNichtVeraendernWarnung|rdiez}}
| + | #REDIRECT [[Benutzer:Rdiez/PageRemoved]] |
| − | | + | |
| − | If you are using Microsoft Outlook, chances are that you are in a corporation and your mailbox has a limited size.
| + | |
| − | Therefore, you need to delete e-mails often, or at least the biggest file attachments.
| + | |
| − | | + | |
| − | In Mozilla Thunderbird, when you delete an e-mail attachment, the e-mail still remembers the attachment's filename,
| + | |
| − | so that you know that an attachment was there in the past. However, in Microsoft Outlook, if you delete an attachment, it's gone without trace. Later on, you don't know
| + | |
| − | if an e-mail ever had an attachment, or who sent you a particular file.
| + | |
| − | | + | |
| − | This script emulates Thunderbird's behaviour in Outlook. Usage scenarios are:
| + | |
| − | | + | |
| − | # You open an e-mail, press the button associated to this script, and then attachments are gone, but text lines like the following are automatically prepended to the e-mail: <br/> [Attachment deleted: myfile1.zip] <br/> [Attachment deleted: myfile2.zip] <br/> The e-mail is marked as modified but not automatically saved. You can then discard changes and get your attachments back if you wish. <br/> This is the scenario I had in mind when I wrote this script. | + | |
| − | # You can also mark several e-mails without opening them and do the same as for case (1).<br/> If there is more than one e-mail, you'll get a confirmation dialog box. <br/> There are 2 different ways to approach this task:
| + | |
| − | ## You don't open the e-mails. <br/> The script would need to save changes immediately. Otherwise, all changes will be lost without confirmation when you close Outlook. I chose not do to this, because it's risky, the user can lose important data.
| + | |
| − | ## Open all e-mails and modify them. <br/> This is similar to scenario (1), but may leave behind many open e-mails. Every time the user tries to close one, he'll be prompt in ordre to save or discard the changes. This is the option I chose to implement.
| + | |
| − | | + | |
| − | It would have been better to decide between (1) and (2.2) based on whether the user has selected e-mails
| + | |
| − | on a list, or whether the user has opened a single e-mail. However, I don't know how to distinguish those scenarios yet in VBA code.
| + | |
| − | | + | |
| − | This script has been tested with Outlook 2010.
| + | |
| − | | + | |
| − | In order to install this script in your Outloook, you need to enable the developer tools ribbon, copy the source code
| + | |
| − | below to the default project, and then create a ribbon icon for it on all the ribbons you would like to access this script from.
| + | |
| − | | + | |
| − | <pre>
| + | |
| − | <nowiki>
| + | |
| − | Public Sub DeleteAttachmentsButLeaveTheirFilenamesBehind()
| + | |
| − | | + | |
| − | On Error GoTo ErrorHandler:
| + | |
| − | | + | |
| − | Dim objOL As Outlook.Application
| + | |
| − | Set objOL = CreateObject("Outlook.Application")
| + | |
| − |
| + | |
| − | Dim objSelection As Outlook.Selection
| + | |
| − | Set objSelection = objOL.ActiveExplorer.Selection
| + | |
| − |
| + | |
| − |
| + | |
| − | ' In the first pass, we just count the number of attachments to delete,
| + | |
| − | ' in order to ask for confirmation if necessary.
| + | |
| − | | + | |
| − | Dim emailCount As Integer
| + | |
| − | Dim attachmentCount As Integer
| + | |
| − | Dim objMsg1 As MailItem
| + | |
| − | | + | |
| − | For Each objMsg1 In objSelection
| + | |
| − | If objMsg1.Class = olMail Then
| + | |
| − |
| + | |
| − | emailCount = emailCount + 1
| + | |
| − |
| + | |
| − | Dim objAttachments1 As Outlook.Attachments
| + | |
| − | Set objAttachments1 = objMsg1.Attachments
| + | |
| − |
| + | |
| − | Dim msgAttachmentCount1 As Long
| + | |
| − | msgAttachmentCount1 = objAttachments1.Count
| + | |
| − |
| + | |
| − | attachmentCount = attachmentCount + objAttachments1.Count
| + | |
| − | End If
| + | |
| − | Next
| + | |
| − |
| + | |
| − | Dim msgboxRes As VbMsgBoxResult
| + | |
| − |
| + | |
| − | If emailCount = 0 Then
| + | |
| − | msgboxRes = MsgBox("No e-mails selected.", vbOKOnly + vbCritical)
| + | |
| − | Exit Sub
| + | |
| − | End If
| + | |
| − |
| + | |
| − | If attachmentCount = 0 Then
| + | |
| − | msgboxRes = MsgBox("No attachments found in " & emailCount & " e-mail(s).", vbOKOnly + vbCritical)
| + | |
| − | Exit Sub
| + | |
| − | End If
| + | |
| − |
| + | |
| − | If emailCount > 1 Then
| + | |
| − | msgboxRes = MsgBox("Would you like to remove " & attachmentCount & " attachment(s) from " & emailCount & " e-mail(s)?", vbYesNo + vbQuestion + vbDefaultButton2)
| + | |
| − | If msgboxRes = vbNo Then
| + | |
| − | Exit Sub
| + | |
| − | End If
| + | |
| − | End If
| + | |
| − | | + | |
| − |
| + | |
| − | ' In the second pass, we remove the attachments. Note that the e-mails could have changed in the meantime.
| + | |
| − | ' However, it's rare to hit that window of opportunity.
| + | |
| − |
| + | |
| − | Dim deletedMsg As String
| + | |
| − | Dim objMsg2 As MailItem
| + | |
| − | | + | |
| − | For Each objMsg2 In objSelection
| + | |
| − | If objMsg2.Class = olMail Then
| + | |
| − |
| + | |
| − | ' Open all e-mails we are going to change. Otherwise, if the user closes Outlook, any changes will be discarded.
| + | |
| − | ' See the big comment above for more information.
| + | |
| − | objMsg2.Display
| + | |
| − |
| + | |
| − | Dim objAttachments2 As Outlook.Attachments
| + | |
| − | Set objAttachments2 = objMsg2.Attachments
| + | |
| − |
| + | |
| − | Dim msgAttachmentCount2 As Long
| + | |
| − | msgAttachmentCount2 = objAttachments2.Count
| + | |
| − |
| + | |
| − | If msgAttachmentCount2 > 0 Then
| + | |
| − | deletedMsg = ""
| + | |
| − | | + | |
| − | Dim i As Long
| + | |
| − | For i = msgAttachmentCount2 To 1 Step -1
| + | |
| − | deletedMsg = "[Attachment deleted: " & objAttachments2.Item(i).FileName & "]" & vbCrLf & deletedMsg
| + | |
| − | objAttachments2.Item(i).Delete
| + | |
| − | Next i
| + | |
| − | deletedMsg = deletedMsg & vbCrLf
| + | |
| − |
| + | |
| − | Dim objInsp As Outlook.Inspector
| + | |
| − | Set objInsp = objMsg2.GetInspector
| + | |
| − |
| + | |
| − | Dim objDoc As Object ' I haven't found out yet how to reference the Word classes from an Outlook 2010 VBA project,
| + | |
| − | ' so I had to use a generic 'Object' type instead. The WdProtectionType constants below
| + | |
| − | ' are not defined either, so I had to use their numeric values.
| + | |
| − | Set objDoc = objInsp.WordEditor
| + | |
| − |
| + | |
| − | ' This was an attempt to execute the "EditMessage" command on thee-mail,
| + | |
| − | ' but the call to 'Unprotect' below fails on my Outlook 2010:
| + | |
| − |
| + | |
| − | ' If you open an e-mail from the 'Drafts' folder, you can change it straight away. Otherwise, you normally
| + | |
| − | ' get a write-protected view, where you can delete attachments (!) but not modify the text.
| + | |
| − | ' In order to lift the protection, I tried a number of ways:
| + | |
| − | ' - ActiveWindow.View.ReadingLayout = False
| + | |
| − | ' - objDoc.UnProtect
| + | |
| − | ' - objDoc.Protect WdProtectionType.wdNoProtection
| + | |
| − | ' - objOL.ActiveInspector.CommandBars.ExecuteMso ("EditMessage")
| + | |
| − | ' None of the above worked, but I did find a method to remove the protection, see below:
| + | |
| − |
| + | |
| − | If objDoc.ProtectionType = 3 Then ' Value 3 means WdProtectionType.wdAllowOnlyReading.
| + | |
| − | objInsp.CommandBars.ExecuteMso ("EditMessage")
| + | |
| − | End If
| + | |
| − |
| + | |
| − | If True Then
| + | |
| − | ' This method seems to work for all possible e-mail formats.
| + | |
| − | objDoc.Characters(1).InsertBefore deletedMsg
| + | |
| − | Else
| + | |
| − | ' Old method, now unused, only kept for future reference.
| + | |
| − | If objMsg2.BodyFormat = olFormatHTML Then
| + | |
| − | ' Here we should do HTML escaping.
| + | |
| − | deletedMsg = Replace(deletedMsg, vbCrLf, "<br/>")
| + | |
| − | objMsg2.HTMLBody = "<p>" & deletedMsg & "</p>" & objMsg2.HTMLBody
| + | |
| − | ElseIf objMsg2.BodyFormat = olFormatRichText Then
| + | |
| − | ' I did not manage to edit the RTF format directly yet, because objMsg2.RTFBody
| + | |
| − | ' is not a string, but an array of bytes.
| + | |
| − | Err.Raise vbObjectError, , "Modifying an e-mail in RTF format not supported yet."
| + | |
| − | ElseIf objMsg2.BodyFormat = olFormatPlain Then
| + | |
| − | objMsg2.Body = deletedMsg & objMsg2.Body
| + | |
| − | Else
| + | |
| − | Err.Raise vbObjectError, , "Unknown message text format."
| + | |
| − | End If
| + | |
| − | End If
| + | |
| − | End If
| + | |
| − | End If
| + | |
| − | Next
| + | |
| − |
| + | |
| − | Exit Sub
| + | |
| − |
| + | |
| − | ErrorHandler:
| + | |
| − |
| + | |
| − | Dim errMsgboxRes As VbMsgBoxResult
| + | |
| − | errMsgboxRes = MsgBox("Error: " & Err.Description, vbOKOnly + vbCritical)
| + | |
| − |
| + | |
| − | End Sub
| + | |
| − | </nowiki>
| + | |
| − | </pre>
| + | |
