Vælge underfolder i Outlook
Hej allesammenSom ret grøn har jeg et spørgsmål til et Vbs-script.
Nedenstående script eksporterer alle mails og vedhæftede filer til html-filer og mapper. Hvad skal ændres således at det kun er en undermappen til min inbox der kopieres fra?
Sub ExportToHTML()
'This code is based on the work of ediscovery, available at ediscovery.wordpress.com
'The save attachments bit is based on Michael Brederlau's post on OutlookCode.com
'To use paste the entire example code into ThisOutlookSession (or other Project) from
'within the VB editor
'####################################################################################
'WARNING 1: This script cannot cope with anything other than ordinary emails (so no invites, read
'receipts, delivery receipts etc), ordinary can of course mean any format (HTML, TXT, RTF etc)
'WARNING 2: This script also won't work at all if you don't read through it and change the folder
'paths to real folders in your system. You have to create the folders before using this script.
'It is reccomended that you have the attachments folder as a sub folder of the main message folder.
'####################################################################################
'Declare variables
Dim inBox As Outlook.MAPIFolder
Dim objEmail As MailItem
Dim inBoxItems As Outlook.Items
Dim i As Integer
Dim objAttachments As Object
Dim SubjectText As String
Dim SubjectDate As Date
Dim NewSubjectText As String
Dim Length As Integer
Dim Attachments As Integer
Dim Message
'Set folder you wish to export from - by default this is set as the Inbox only
Set inBox = Me.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
'Get the items from the folder and set to the variable you declared
Set inBoxItems = inBox.Items
'Sort them by date
inBoxItems.Sort "SentOn", 1
'Set loop counter to 1
i = 1
'For each of the itms in the selected folder
For Each objEmail In inBoxItems
'We create a new Mail item for each object in the folder
Dim mailObj As MailItem
Set mailObj = objEmail
'First we check the message format and process accordinglyQ
If (objEmail.BodyFormat = olFormatPlain Or olFormatRichText Or olFormatUnspecified) Then
mailObj.BodyFormat = olFormatHTML 'Converts body to HTML if not HTML format
End If
'Then we get the attachments
Set objAttachments = mailObj.Attachments
'If there are some
If objAttachments.Count > 0 Then
'for all attachments do...
For Attachments = 1 To objAttachments.Count
'###########################################################################
'EDIT THE LINK HERE OR THIS WON'T WORK
'By default it links to a sub folder called Attchments
'###########################################################################
'Add name and destination to message text
mailObj.HTMLBody = mailObj.HTMLBody & vbCrLf & Chr(60) & "A HREF=" & Chr(34) & "Attachments\" & Format(i, "0000") & ", " & objAttachments(Attachments).DisplayName & Chr(34) & Chr(62) & objAttachments(Attachments).DisplayName & Chr(60) & "/A" & Chr(62) & Chr(60) & "BR" & Chr(62) & vbCrLf
'Save them to destination
'###########################################################################
'EDIT THE FOLDER NAMED HERE OR THIS WON'T WORK
'###########################################################################
objAttachments(Attachments).SaveAsFile "C:\workspace\Attachments\" & Format(i, "0000") & ", " & objAttachments(Attachments).DisplayName
Next Attachments
End If
'Then we check the subject text, and remove and : which will kill the sub
SubjectText = objEmail.Subject
SubjectDate = objEmail.ReceivedTime
Length = 1
NewSubjectText = ""
For Length = 1 To Len(SubjectText)
If (Mid(SubjectText, Length, 1) = Chr(58)) Or (Mid(SubjectText, Length, 1) = Chr(92)) Or (Mid(SubjectText, Length, 1) = Chr(47)) Or (Mid(SubjectText, Length, 1) = Chr(34)) Or (Mid(SubjectText, Length, 1) = Chr(60)) Or (Mid(SubjectText, Length, 1) = Chr(62)) Or (Mid(SubjectText, Length, 1) = Chr(42)) Or (Mid(SubjectText, Length, 1) = Chr(63)) Then
NewSubjectText = NewSubjectText & " - "
Else
NewSubjectText = NewSubjectText & Mid(SubjectText, Length, 1)
End If
Next
'Save the HTML Email
'###########################################################################
'EDIT THE FOLDER NAMED HERE OR THIS SCRIPT WON'T WORK
'###########################################################################
mailObj.SaveAs "C:\workspace\" & Format(i, "0000") & ", " & Format(SubjectDate, "dddd mmmm dd yyyy") & ", " & NewSubjectText & ".html", olHTML
'Counter used to name emails and attachments
i = i + 1
Next
End Sub
Jeg går ud fra at det er noget af følgende der skal ændres:
'Set folder you wish to export from - by default this is set as the Inbox only
Set inBox = Me.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
