"Sten Christensen" <aogsc@brockstedt-rasmussen.dk> skrev i en meddelelse
news:462b8642$0$145$edfadb0f@dread11.news.tele.dk...
> Jeg er ved at prøve på at lave en makro i Outlook. Det jeg ønsker er en
> let og hurtig adgang til at gemme e-mails i de mapper, hvor jeg har den
> øvrige word-korrespondance. Jeg er klar over, at e.mails ikke uden videre
> kan konverteres til word-format, men er tilfreds med at kunne gemme dem i
> txt-format.
> Filnavnet kan pasende være indholdet af emne feltet men med mulighed for
> at supplere eller ændre navnet.
> Mappen filen skal gemmes i skal selvfølgelig indtastes manuelt, men det
> skulle helst også være den eneste manuelle operation.
> Jeg bruger Windows XP, prof, og Office 2000.
> Hvem kan hjælpe?
>
Der findes faktisk en hændelse, der hedder "Application_ItemSend" i Outlook,
MEN den aktiveres FØR mailen afsendes - så du kan faktisk komme til at gemme
en mail, som reelt IKKE er sent.
Jeg bruger filedialogen fra Excel til at vælge, hvilken windowsmappe, der
skal gemmes i, og mailen gemmes som en "mail" - som jo evt. skal genlæses i
Outlook - men du 2-klikker jo bare på filen, hvis du vil genlæse mailen.
Med ovenstående lille specialitet in mente kan du f.eks. gøre således:
I ThisOutlookSession lægger du følgende:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
FolderN = BrowseFolder("Hvilken mappe vil du gemme i ?")
If FolderN <> "" Then
Item.SaveAs FolderN & "\" & StripIllegaleTegn(CStr(Item)) & ".msg"
End If
End sub
Og dette lægges ned i et tilføjet modul:
Function BrowseFolder(S As String) As String
Dim Exl As Excel.Application, Fd As FileDialog
Set Exl = New Excel.Application
Exl.Visible = False
Set Fd = Exl.FileDialog(msoFileDialogFolderPicker)
With Fd
.Title = S
.ButtonName = "Gem i denne mappe"
If .Show = -1 Then
' Hvis der er trykket "gem"
BrowseFolder = Fd.InitialFileName
Else
' Hvis der trykkes annuller
End If
End With
Exl.Quit
Set Fd = Nothing
Set Exl = Nothing
End Function
Function StripIllegaleTegn(F As String) As String
Const Forbudt = "/\><*?""|:;"
Const Tilladt = "-"
Dim X As Byte, Y As Byte
Dim ForbudtTegn As String
For X = 1 To Len(Forbudt)
ForbudtTegn = Mid(Forbudt, X, 1)
For Y = 1 To Len(F)
If InStr(1, F, ForbudtTegn) <> 0 Then
Mid(F, InStr(1, F, ForbudtTegn)) = Tilladt
End If
Next Y
Next X
StripIllegaleTegn = F
End Function