VBscript for å flytte/slette eposter i Outlook basert på innhold i emne

[Khaffner]

Jeg har lite erfaring med VBscripting. Har hittil bare lagd ett script tidligere for å starte windows-applikasjoner basert på filtilstedeværelse i en gitt mappe.

 

Problemstillingen er i jobbsammenheng, så jeg vil ikke røpe for mye detaljer.

 

Jeg har en postboks i Outlook 2010 med 6 mapper under innboksen. La oss kalle de

- Majorstuen

- Sagene

- Grønland

- Vinderen

- Tøyen

- Ferdig

 

Den postboksen får av og til automatisk tilsendt eposter med emnetittel som følger malen

*Bydel* *Enhet* *Feilkode*

Når eposten kommer, flyttes den til en mappe som matcher *Bydel*. Når eposten er ferdigbehandlet flytter jeg den manuelt til Ferdig-mappen. Det er dette jeg vil endre.

Systemet kan nemlig sende en automatisk epost når problemet er løst på enheten. Jeg tenkte å la den følge malen

*Bydel* *Enhet* *Feilkode*OK.

 

Det jeg ønsker, er et script som kjøres når den sistnevnte eposten ankommer. Scriptet skal flytte førstnevnte epost til Ferdig-mappen, og slette sistnevnte epost.

 

Kan dere hjelpe meg i gang?

[Alexen]

Bare for å klarere. Du kan vel rote rundt i mailer med vbscript, men jeg ser for meg at det beste er å bruke vba som er det innebygde scriptverktøyet i outlook. En fremgangsmåte er vel å lage en regel på innkommende post som inneholder "OK", denne starter en scriptrutine. Denne kan se noe sånn ut:

 

 

Public Sub ProcessIncomingMail(Item As Outlook.MailItem)
 MsgBox "hello mail"
End Sub

 

 

For å få laget denne kodesnutten trykker du Alt+F11 for å åpne vba-editoren. Deretter kan du ved hjelp av "rule wizard" (sorry, har engelsk office) koble scriptet til inkommende mail med "OK" i emne.

 

Nå vil det poppe opp en dialogboks hver gang du får mail med OK i emne. Morsomt men ikke nyttig. Ser for meg en fremgangsmåte som er noe som:

 

* Hent bydel fra mailemne

- Er bydel alltid et ord? isåfall er det bare å hente ut det som er til venstre for " ".

* Sjekk om mappen bydel finnes og let igjennom etter mail som matcher

- Hvis Mail funnet:

- Flytt til Ferdig mappe

- Slett inkommende mail

- Hvis ikke funnet:

- Burde dette kunne skje? Bør en alarm gå? Skal noen sparkes?

 

Edit: Innrykk fungerte dårlig på den lista der, mine forumskills er svaake.

 

Her er en link med litt vba-info:

 

http://msdn.microsof...e/ee814736.aspx

Endret 2. oktober 2012 av The_Viper@EFNET

[Alexen]

Siden jeg aldri har prøvd vba i outlook tenkte jeg å gi det et forsøk. Kom frem til koden under, som kanskje være et utgangspunkt. Ser ihvertfall ut til å fungere her. Jeg hadde bare gmail å teste med og støtte på en bug som er beskrevet her: http://social.msdn.m...4-5cbfd565eebe/

 

Fikk løst den ved å følge oppskriften der, men virker som det bare er et problem med gmail.

 

Koden forutsetter at man får epost på formatet: <bydel> <avd> <kode> ok. Sånn som den er nå er den case-insensitiv, oSlo og Oslo er altså det samme.

 

 

Public Sub ProcessIncomingMail(IncomingMail As Outlook.MailItem)
Dim Subject As String
Dim Avdeling As String
Dim Bydel As String
Dim Feilkode As String
Dim nWords As Integer
Dim BaseFolder As String

Subject = IncomingMail.Subject
Subject = UCase(Subject)	' Gjør om til store bokstaver
Dim AllWords() As String
AllWords = Split(Subject, " ")
nWords = UBound(AllWords)

If AllWords(nWords) <> "OK" Or nWords <> 3 Then Exit Sub	' Må ende med OK og bestå av 4 ord

Bydel = AllWords(0)
Avdeling = AllWords(1)
Feilkode = AllWords(2)
BaseFolder = "mingmailadresse\[Gmail]\"  ' Må sette inn adressen til epostmappa her

Dim SrcFolder As MAPIFolder ' Mappen vi flytter gammel mail fra
Dim DstFolder As MAPIFolder ' Mappen vi flytter til, hardkodet til "Ferdig"

Set SrcFolder = GetFolder(BaseFolder & Bydel)
Set DstFolder = GetFolder(BaseFolder & "Ferdig")

If SrcFolder Is Nothing Or DstFolder Is Nothing Then Exit Sub   ' Finner ikke en av mappene

Dim Mail As MailItem
Set Mail = FindOldMail(SrcFolder, Avdeling, Feilkode)
If Mail Is Nothing Then
	Exit Sub
Else
	Mail.Move DstFolder
	IncomingMail.Delete
End If

End Sub

Function FindOldMail(Folder As Outlook.Folder, Avdeling As String, Feilkode As String) As MailItem
Dim items As Outlook.items
Set items = Folder.items
For Each Mail In items
Dim Subject As String
Subject = UCase(Mail.Subject)
Dim AllWords() As String
AllWords = Split(Subject, " ")
nWords = UBound(AllWords) ' nWords vil være antall ord - 1
If nWords = 2 Then  ' må være 3 ord
	If AllWords(1) = Avdeling And AllWords(2) = Feilkode Then
		Set FindOldMail = Mail
		Exit Function
	End If
End If
Next
End Function
' Kode stjålet fra: http://www.outlookcode.com/d/code/getfolder.htm
Public Function GetFolder(strFolderPath As String) As MAPIFolder
 ' strFolderPath needs to be something like
 '   "Public Folders\All Public Folders\Company\Sales" or
 '   "Personal Folders\Inbox\My Folder"
 Dim objApp As Outlook.Application
 Dim objNS As Outlook.NameSpace
 Dim colFolders As Outlook.Folders
 Dim objFolder As Outlook.MAPIFolder
 Dim arrFolders() As String
 Dim I As Long
 On Error Resume Next
 strFolderPath = Replace(strFolderPath, "/", "\")
 arrFolders() = Split(strFolderPath, "\")
 Set objApp = Application
 Set objNS = objApp.GetNamespace("MAPI")
 Set objFolder = objNS.Folders.Item(arrFolders(0))
 If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
  Set colFolders = objFolder.Folders
  Set objFolder = Nothing
  Set objFolder = colFolders.Item(arrFolders(I))
  If objFolder Is Nothing Then
	Exit For
  End If
Next
 End If
 Set GetFolder = objFolder
 Set colFolders = Nothing
 Set objNS = Nothing
 Set objApp = Nothing
End Function