Detache vedhæft til mail?

Jeg er ikke med på hvad du vil !

Du modtager en mail hvorfra du vil detache en vedlagt fil over i en ny mail ?

Næh, jeg vil lagre den på min harddisk til videre bearbejdning, f.eks. i Access.

More points needed?

Even more points needed?

Jeg ved det ikke, kan ikke lige gennemskue det ! Men prøv at slappe lidt af, vi sidder her ikke 24 timer i døgnet !

Øeh, det var nu ikke for at oppiske en stemning - jeg satte bare points'ene op, fordi jeg ønskede et svar fra en-eller-anden, og utroligt nok, så har jeg mødt eksempler på, at folk kun går efter spg med mange points. ..og så slapper jeg af i week-enden.

Jeg bruger en makro tildelt en knap. Makroen lægger den vedhæftede fil i en fast defineret mappe, fjerner filen fra e-mailen og indsætter navnet på filen i e-mailen. Koden er fundet på nettet og modificeret (Private Sub RemoveAttachment er ikke med her - for ikke at gøre det for langt).

Sub GemEllerSlet()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Tryk ""Ja"" for både at gemme og fjerne vedhæftede filer." & vbCrLf & vbCrLf & _
"Tryk ""Nej"" for kun at fjerne vedhæftede filer."    ' Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton1    ' Define buttons.
Title = "Gem og fjern eller kun fjern"

svar = MsgBox(Msg, Style, Title)
If svar = vbYes Then
Msg = "De vedhæftede filer gemmes i mappen:" & vbCrLf & vbCrLf & _
"C:\Dokumenter\Modtaget\"    ' Define message.
Style = vbOKCancel + vbInformation + vbDefaultButton1    ' Define buttons.
Title = "Gemmeoplysninger "

svar = MsgBox(Msg, Style, Title)

If svar = vbOK Then
SaveAttachment
Else
GoTo Slut
End If
Else
RemoveAttachment
End If
Slut:
End Sub

Private Sub SaveAttachment()

    'Declaration
   
    Dim myItems, myItem, myAttachments, myAttachment As Object
    Dim myOrt As String
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim fs
    Dim fejl As String
         
   
    'Ask for destination folder
Retry:
    myOrt = "C:\Dokumenter\Modtaget\"
       
    On Error Resume Next
   
    'Does the folderpath exists
'    Set fs = CreateObject("Scripting.FileSystemObject")
'    If fs.FolderExists(myOrt) = False Then
'    fejl = MsgBox("Stien eksisterer ikke." & vbCrLf & _
'    "Tryk ""OK"" og angiv en korrekt sti." & vbCrLf & _
'    "Tryk ""Annuler"" for at afbryde.", vbOKCancel + vbCritical + vbDefaultButton1, "Fejl i sti!")
'    If fejl = vbOK Then
'    GoTo Retry
'    Else
'    GoTo Slut
'    'Exit Sub
'    End If
'    End If
   
    'work on selected items
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
       
    'for all items do...
    For Each myItem In myOlSel
   
    Set myItem.BodyFormat = olFormatRichText
   
        'point on attachments
        Set myAttachments = myItem.Attachments
       
       
        'if there are some...
        If myAttachments.Count > 0 Then
       
            'add remark to message text
            myItem.Body = myItem.Body & vbCrLf & _
                "Vedhæftede fjernet:" & vbCrLf
               
            'for all attachments do...
            For i = 1 To myAttachments.Count
           
                'save them to destination
                myAttachments(i).SaveAsFile myOrt & _
                    myAttachments(i).DisplayName

                'add name and destination to message text
                myItem.Body = myItem.Body & _
                    "Fil: " & myAttachments(i).DisplayName & vbCrLf
                   
            Next i
           
            'for all attachments do...
            While myAttachments.Count > 0
           
                'remove it (use this method in Outlook XP)
                'myAttachments.Remove 1
               
                'remove it (use this method in Outlook 2000)
                myAttachments(1).Delete
               
            Wend
           
            'save item without attachments
'            With myItem
'            .BodyFormat = olFormatRichText
'            .Display
'            .Save
'            End With
           
            myItem.Save
        End If
       
    Next

Slut:
   
    'free variables
    Set myItems = Nothing
    Set myItem = Nothing
    Set myAttachments = Nothing
    Set myAttachment = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
   
MsgBox "De fjernede filers navne er indsat i emnet.", vbOKOnly + vbInformation, "Vedhæftede filer fjernet!"
   
End Sub

... og det er ikke for pointenes skyld. Så den først nu.

Tak, Falster. Selvom jeg kender VB, kan jeg ikke lige få det til at køre, automatisk, fra Outlook. The missing link er nu at starte rutinen inde i en regel, direkte når mailen ankommer - kan vi det?

Du har ret i, at det jo ikke starer automatisk. Kun, når en modtager trykker på knappen. Automatisering med regler er ikke min stærke side. Vender tilbage, hvis jeg kan finde ud af det.

Jeg har et andet projekt, som skal have adgang til Outlook-objekter fra Access - måske kan jeg slå to fluer med ét smæk, hvis jeg kunne starte denne deattach fra Access(?)

Jamen, hvor har du defineret knappen?

Outlook: Funktioner - Tilpas... - faneblad Kommandoer - kategorier: Makroer og så trække og slippe, som der står på fanebladet. Kan vist bruges i alle Officeprogrammerne.

Ok, så langt er jeg ikke kommet. Jeg mangler makroer i Outlook..

Fik nogle gode hints, selvom det ikke blev løst helt. Lukker.