Udtræk af data fra Outlook mail til txt fil og start Word makro

Det skulle nok kunne lade sig gøre. Kunne det tænkes, at VBA-koden lå i en Word-skabelon, som så hentede data fra mailen?

Kan de relevante mails identificeres entydigt, således at andre mails kan udelades?

Det vil være ekstra super, hvis koden kan ligge i Word, da det er her vi har brug for de data der er i de valgte mails.

Mailsene kan godt identificeres, hvis det kan ske ud fra en given mappe de ligger i og så om de er ulæst eller læst. Ellers har jeg ikke lige nogen ideer der kan udpege dem.

Det vil være fint om man kunnne få hver enkelt præsenteret i en msgbox og så sige ja/nej til at køre koden, men det kan jeg nok selv få styr på.

Tak for info..

Mappen - under indbakke - ok?

Læst / ulæst kan testes.
Der kunne være en "Fast tekst" i emne, der kunne identificere.

Hvilken office-version?

Skal Word dokumentet kun rumme een mail?
Navngivning af dokument?

Den ligger ikke under indbakken i dag, men ved siden af. Er det et problem kan det ændres uden det giver kvaler.

Et dokument = en mail. Vi henter normalt 5-15 dokumenter efter hinanden. lige nu navngives, gemmes, printes og lukkes dokumentet i en proces og den tomme skabelonen genåbnes.
Hvis man kan markere mailen som læst i processen og tjekke for det næste gang den åbnes må det kunne løse den del.

Office 2003

Håber det er forståeligt.

Mappe-placering - skulle ikke være et problem.

Er der mere tekst i mailen end de 15 linjer?

Navngivning af dokument - kunne det ske automatisk?
Måske på basisaf afsender eller?

Mailen kan automatisk markeres som læst og status ligeledes testes automatisk.

Office 2003 - anvender selv 2007 - der er blive noget med referencer - men det skal jeg nok "supporte".

Ja, de 15 var blot "et skud fra hoften", reelt er der 22. Men regner selv med at kunne lave de justeringer der skal til specifikt for at få det til at spille.

Dokumentet bliver i dag navngivet automatisk og skal helst ikke ændres (sker på baggrund af 2 af linierne i mailen. ( Linie1 & " - " & linie2 )

Jeg er ikke online mere før i aften, så et manglende svar på nye indlæg kommer først senere i dag :-)

Tak & ok..

Rem version 1 - skrevet i V/2007 - gem som 2003.dot
Rem ===============================================
Rem Reference sat til: Microsoft Outlook 12.0 Object Library - skal justeres til 2003-versionsNr (11.0)
Rem ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Rem Evt. til at forhindre "Et program forsøger..."
Rem www.contextmagic.com/express-clickyes/Free-version.htm
Rem ============================================================
Const gemDokSti = "C:\Documents and Settings\pb.KHNBPB\Skrivebord\922481\"  '<------- justeres

Const overMappenavn = "Private Mapper"  '<-------------- korriger navn
Const mappenavn = "TestMappe"  '<---------------- indsæt navn på relevante mappe (sideordnet indbakke)

Const antalBodyLinjer = 22          '<------- evt. korriger antal linjer fra mail, der skal overføres til Word

Dim antalMails As Integer, mappen
Private Sub Document_New()
    HentMails
End Sub
Public Sub HentMails()
    antalMails = åbnOutlookMappe(mappenavn)
    traverserMappen antalMails
End Sub
Private Function åbnOutlookMappe(mappenavn)
Dim mailApp, nameSpace, aFold, bFold, cFold

    Set mailApp = CreateObject("Outlook.Application")
    Set nameSpace = mailApp.GetNamespace("MAPI")
    Set aFold = nameSpace.Folders
    Set bFold = aFold(overMappenavn)
    Set mappen = bFold.Folders(mappenavn)
   
    åbnOutlookMappe = mappen.Items.Count
End Function
Private Sub traverserMappen(antalMails)
Dim afsender As String, modtaget As String
Dim tekst As String, tekst1 As String
Dim mx As MailItem, primærTekst1 As Variant, primærTekst2 As String
    If antalMails > 0 Then
        For m = 1 To antalMails
            Set mx = mappen.Items(m)
           
Rem Er mailen ulæst
            If mx.UnRead = True Then
                afsender = mx.SenderEmailAddress
                modtaget = Replace(CStr(mx.ReceivedTime), ":", "")
               
                tekst = mx.Body
                tekst1 = Replace(tekst, Chr(13) & Chr(10) & Chr(13) & Chr(10), "|", Count:=antalBodyLinjer)
               
                primærTekst1 = Split(tekst1, "|")
                x = UBound(primærTekst1)
               
                primærTekst2 = ""
               
                For f = 0 To x - 1
                    primærTekst2 = primærTekst2 & primærTekst1(f) + vbCr
                Next f
               
Rem Indsætter tekster 22 afsnit fra mail
                ActiveDocument.Select
                Selection.HomeKey Unit:=wdStory
                Selection.TypeText Text:=primærTekst2
               
Rem Gemmer og udskriver
                ActiveDocument.SaveAs gemDokSti + afsender & " " & modtaget & ".doc"
                ActiveDocument.PrintOut
               
Rem Rydder indhold
                Selection.WholeStory
                Selection.Delete Unit:=wdCharacter, Count:=1

                mx.UnRead = False
                mx.Save
               
            End If
        Next m
        ActiveDocument.Close Savechanges:=wdDoNotSaveChanges
        Application.Quit
    End If
End Sub

Hej Supertekst

Det ser meget lovende ud det du har lavet ind til nu.

Jeg har fået rettet koden til så den passer til mine mapper mv.

Jeg får en fejl i linien Dim mx As MailItem, hvor jeg får følgende fejl "User-defined type not defined". (det er nok her mine evner ikke helt rækker til som amatør)

Beklager jeg ikke har vent tilbage før, men har ikke fået mail(ellers også er den smuttet forbi) om der var kommet nyt indlæg. De næste dage er jeg regelmæssigt online.

Ok - har du sat reference til Outlook?
(Vba-vinduet(Alt+F11) / Tools / References / Microsoft Outlook 12.0 Object Library - skal justeres til 2003-versionsNr (11.0)

Er gjort (skete automatisk da jeg gemte som 2003 skabelon

Prøv at tage et skærmprint af dine referencer- evt. indsæt i et Word-dok og send dette til mig.

(@-adresse under profil)

Manglende ref. til Outlook var årsagen..