Köra ett Script från en regel - Exempel
Problem:
Jag vill kunna köra ett script från en regel i Outlook
Lösning:
- Starta upp Outlook
- Klicka på Visual Basic Editor under Tools/Macros i menyn
- Dubbelklicka på ThisOutlookSession
- Kopiera scriptet nedan och klistra in det i fönstret som öppnades när du dubbelklickade på ThisOutlookSession
- Stäng Visual Basic Editorn och återgå till Outlook
- Gå in på Tools/Rules and Alerts
- Klicka på New Rule
- Välj Start from blank rule, se till att ”Check messages when they arrive” är iklickat och klicka ”Next”
- Klicka i ”From People or Distribution List”
- Klicka på “People or Distribution List” I det under fönstret
- I fältet ”From” längst ned skriver du in adress som mailen kommer ifrån. Klicka sedan ”Next”.
- Bocka i ”Run a script”
- Klicka på “a script” i det under fönstret och välj ”Project1.ThisOutlookSession.Save_Gas_Matters_Attach” och klicka ”Ok” Klicka sedan Next
- Klicka Finish
Förutsättning för att ett Script skall fungera att köra från en regel:
A macro for use with a rule must be a Public Sub with a MailItem or MeetingItem argument, e.g.:
Public Sub SaveAttachmentsToFolder(objMail as MailItem)
' code to save attachments in the objMail message
End Sub
Exempel Script
Script för att automatiskt spara attachments
Sub Save_Gas_Matters_Attach(objMsg As MailItem)
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
myOrt = "C:" 'destination folder
On Error GoTo ErrHandler
Set myItem = objMsg
Set myAttachments = myItem.Attachments
'if there are some...
If myAttachments.Count > 0 Then
'add remark to message text
myItem.Body = myItem.Body & vbCrLf & "Saved Attachment(s):" & vbCrLf
'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt & myAttachments(i).DisplayName
'add name and destination to message text
myItem.Body = myItem.Body & "File: " & myOrt & myAttachments(i).DisplayName & vbCrLf
Next i
End If
GoTo SkipErrorHandlingBit
ErrHandler:
' Error has occured, put a message in the email text.
myItem.Body = myItem.Body & vbCrLf & "File has not been saved!" & vbCrLf
SkipErrorHandlingBit:
'save item without attachments
myItem.Save
'free variables
Set myItem = Nothing
Set myAttachments = Nothing
End Sub
Sub Reportave()
Dim oApp As Application
Dim oNS As NameSpace
Dim oMsg As Object
Dim oAttachments As Outlook.Attachments
Dim lngCount As Single
Set oApp = New Outlook.Application
Set oNS = oApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
For Each oMsg In
oFolder.Items
lngCount = oMsg.Attachments.Count
If lngCount > 0 Then
For i = lngCount To 1 Step -1
' Save attachment before deleting
tmpfile = oMsg.Attachments.Item(i)
tmpfile = "c:" & tmpfile
tmpsender = oMsg.SenderName
tmpmessage = MsgBox("Guardando archivo " & Trim(tmpfile) & "enviado por " & tmpsender, vbOKOnly)
oMsg.Attachments.Item(i).SaveAsFile tmpfile
tmpmessage = MsgBox("Eliminando adjunto " & Trim(tmpfile), vbOKOnly)
oMsg.Attachments.Remove i
Next i
End If
Next
End Sub