Macro til at gemme mails på C_drev

Jeg kan næsten forstå, at du ikke bare vil gemme outlook.pst på en eller anden lokation?

Nettop, hver mail sin egen "lille" fil som kan håndteres som alle andre filer i forbindelse med kundeopdelt arkivering etc i en gammeldags filstruktur

Jeg var inde at kigge i Outlooks Help-funktion under VBA, og jeg tror det er her svaret skal findes. Flg. kodestump er IKKE svaret, men så kan du se hvad jeg mener:

MyObj.Insert "Hello, world."    ' Place text.
MyObj.Bold = True    ' Format text.
If Mac = True    ' Check your platform constant
    MyObj.SaveAs  "HD:\WORDPROC\DOCS\TESTOBJ.DOC"    ' Save the object (Macintosh).
Else
    MyObj.SaveAs  "C:\WORDPROC\DOCS\TESTOBJ.DOC"    ' Save the object (Windows).



Her må man kunne angive, at indkomne mails gemmes i C:\xxx\yyy\[subject].msg på en eller anden måde. Jeg vil kigge nærmere på det senere i dag, når jeg får lidt mere tid :)

Hvis du har mod på det selv, så prøv at søge på "save as *.msg" i Smart søgning. Vender tilbage.

Skal den gemme alle mails i en outlook mappe, til en folder på c-drevet, eller skal den gemme hvergang der kommer en mail ind og bliver en mail sendt?

VH CK

Her er koden til at gemme (og slette alle mails i indbakken i en mappe der hedder c:\mails/)


Sub saveAllMsg()
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim i As Integer
    Dim ex As Explorer
    Dim item As MailItem
    Set ex = Application.ActiveExplorer
    i = 1
    If Not fso.FolderExists("c:\Mails\") Then
        If MsgBox("Mappen Mails på dit C-drev er ikke oprettet, ønsker du at oprette den nu?", vbQuestion + vbYesNo) = vbYes Then
            fso.CreateFolder "c:\Mails\"
        Else
            Exit Sub
        End If
    End If
    For Each item In ex.CurrentFolder.Items
        item.SaveAs "c:\Mails\" & Replace(Replace(item.Subject, ":", ""), "?", "") & " - " & i & ".msg", OlSaveAsType.olMSG
        'fjern udkommentaringen af følgende linie, hvis du ønsker mailen skal slettes med det samme
        'item.Delete
        i = i + 1
    Next
    Set fso = Nothing
End Sub


VH CK

Lukketid?