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