Avatar billede darkstylerdk Nybegynder
22. december 2009 - 13:01 Der er 1 kommentar

Vælge underfolder i Outlook

Hej allesammen
Som 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)
Avatar billede supertekst Ekspert
22. december 2009 - 15:01 #1
Uddrag fra VBA-kode:
returMappeNavn indeholder navnet på mappen i Indboks

    Set mailApp = CreateObject("Outlook.Application")
    Set Namespace = mailApp.GetNamespace("MAPI")
    Set aFold = Namespace.GetDefaultFolder(olFolderInbox)
    Set mappen = aFold.Folders(returMappeNavn)
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester



Seneste spørgsmål Seneste aktivitet
I dag 06:10 Excel åbner fil i kæmpe format Af Aske i Excel
I går 22:00 Datafordeler Af Lsk i PHP
I går 12:37 Summere beløb pr. dato Af TTA i Excel
31/1022:44 Tilslutte chassic fans Af viking69 i PC
31/1020:28 LED lysstofrør Af ErikHg i Fri debat