Vedhæftede filer i "sendt post"

Et godt bud her, ville være en makro der fjernede filerne, smed dem ned på disken og lavede en reference... og så bruger man den makro til at køre ved afsendelse af mails.

/Christian
ck@officekonsulenterne.dk

Det lyder smart, men jeg ved ikke rigtigt, hvordan man arbejder med makroer.
Og filerne ligger jo allerede på harddisken. Vil de så fortsat findes 2 steder?
mvh
Pernille

Hej

Ja jeg kan godt se det er problematisk, hvis du ønsker filerne skal blive liggende på deres originale placering og der blot skal indsættes et link til dem i en afsendte mail. I det øjeblik du indsætter filer som vedhæftninger i Outlook, så mister de deres "tilhørsforhold" til disken.

Jeg har nedenunder her lavet en makro, der tager alle de vedhæftet filer i den afsendte mail og gemmer dem i den mappe på c: der hedder "OutlookFil". herefter indsætter et llink i mailen til dem, og sltter dem fra mailen.

Hvis du tager denne kode og indsætter i VBA editoren i Outlook under modulet ThisOutlookSession så kan du teste om det virker. Og ja jeg ved godt den gemmer en ekstra kopi af filerne... men det mener jeg ikke der er noget at gøre ved.

Dim WithEvents itms As items

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Set itms = GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).items
End Sub

Private Sub itms_ItemAdd(ByVal Item As Object)
    Dim itm As Object
    Dim att As Attachment
    Set itm = Item
   
    While itm.Attachments.Count > 0
        Set att = itm.Attachments.Item(1)
        att.SaveAsFile "C:\OutlookFil\" & Replace(Now, ":", "") & att.FileName
        itm.Body = itm.Body & vbCrLf & vbCrLf & "C:\OutlookFil\" & Replace(Now, ":", "") & att.FileName
        att.Delete
        itm.Save
    Wend
End Sub


Håber det kan bruges, du er velkommen til at spørge igen både her og på mail ck@officekonsulenterne.dk

/Christian

Hej igen.
Jeg har nu forsøgt med din makro, men det virker ikke efter hensigten. Jeg har sandsynligvis gjort noget galt i forbindelse med opretning af makroen.(som skrevet tidligere ved jeg ikke rigtigt noget om det).
Der kommer en fejlbesked: "Compile error: Only valid in object module".
Og denne kommer også: "Macros in this project are disabled. Please refer to the online manual..."
Kan du se af det, hvad jeg gøre galt?
Mvh
Pernille

Ja den første ting er ihvertfald at du skal slå makroer til i din Outlook. Dvs. du skal gå i menuen funktioner - makro - sikkerhed og her vælge mellem sikkerhed. Herefter genstarte Outlook. Når du bliver spurgt efter om du vil aktivere Makroen skal du blot svare Ja.

Compile fejl - hmmm, der kan være flere ting... er koden placeret i modulet "ThisOutlookSession" (jeg kan ikke huske om det hedder noget andet i den danske udgave af Outlook")

/Christian

Hej Christian.
Nu virker det sørme (valgte bare "mellem sikkerhed" for makroer), og det er egentlig en udmærket løsning.
Men - det ville være endnu bedre, hvis det var muligt at linket til filen kunne være den oprindelige fils placering? Eller der kunne måske linkes til begge filer? (både den oprindelige og den i "C:/Outlook"-mappen.
Og lige endnu et spørgsmål:
Er der en måde, man kan undgå at programmet kommer med følgende spørgsmål: "Et program prøver at få adgang til de e-mailadresser, du har gemt i Outlook. Vil du
tillade det?" Og så skal man give adgang i et antal minutter.

Mvh
Pernille

Hej Pernille

Hvis du downloader denne zipfil  http://www.dimastr.com/redemption/Redemption.zip , udpakker den og installere exe filen og bruger nedenstående kode. Så vil du kunne undgå den irriterende boks der popper op ;)



Dim WithEvents itms As Items

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Set itms = GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub itms_ItemAdd(ByVal Item As Object)
    Dim itm As Object
    Dim att As Attachment

    Set itm = CreateObject("Redemption.SafeMailItem")
    itm.Item = Item
   
    While itm.Attachments.Count > 0
        Set att = itm.Attachments.Item(1)
        att.SaveAsFile "C:\OutlookFil\" & Replace(Now, ":", "") & att.FileName
        itm.Body = itm.Body & vbCrLf & vbCrLf & "C:\OutlookFil\" & Replace(Now, ":", "") & att.FileName
        att.Delete
        itm.Save
    Wend
End Sub

Hvad angår link til de originale filer, den tænker jeg stadig lidt over :)

/Christian
ck@officekonsulenterne.dk

Hej Christian.
Nu har jeg givet dig point, men hvis du skulle finde på en løsning med linket til de originale filer, så er jeg stadig meget interesseret i det.
Tak for hjælpen.
Mvh
Pernille