Oprettelse af regel der automatisk detacher vedhæftede filer.....

Jeg mener ikke det er muligt ved brug af regler.
Jeg har dog en makro der kopierer attachments fra alle indkomne mails til en bestemt mappe, hvis det havde interesse  ?

Det har da bestemt interesse :-)

Skal lige rette den lidt til...

OK

I Outlook, tryk ALT + F11.
Indsæt følgende kode under ThisOutlookSession

--------------------------------

Private Sub Application_NewMail()
    StripAttachments ("F:\Attachments\")    'Remember last backslash '\'
End Sub


'---------------------------------------------------------------------------------------
' Procedure : Strip
' DateTime  : 21-12-2002 23:26
' Author    : Thomas Christensen (tc@elvis.dk)
' Purpose  : Recursively saves attachments in user-defined directory
'            Checks for embedded mail items and saves attachments from these, if found
'---------------------------------------------------------------------------------------
'
Private Sub Strip(MailitemToStrip As MailItem, SaveDir As String)

On Error GoTo ErrorHandler

Dim i As Integer
Dim MItem As MailItem

Set MItem = MailitemToStrip
Dim SaveFilename As String
Dim msg As Object

With MItem.Attachments
   
    If .Count = 0 Then
        Exit Sub
    ElseIf .Count > 0 Then
        For i = 1 To .Count
            If Right(MItem.Attachments(i).FileName, 3) = "msg" Then
                SaveFilename = SaveDir & MItem.Attachments.Item(i).FileName
                MItem.Attachments.Item(i).SaveAsFile SaveFilename
                Set msg = Application.CreateItemFromTemplate(SaveFilename)
                Call Strip(msg, SaveDir)
               
                '' Delete temporary Outlook messages
                If Not Dir(SaveFilename) = "" Then
                    Kill SaveFilename
                End If
                Set msg = Nothing
               
            Else
                '' Save attachments that are not Outlook messages
                SaveFilename = SaveDir & MItem.Attachments.Item(i).FileName
                MItem.Attachments.Item(i).SaveAsFile SaveFilename
            End If
           
        Next i
    End If
   
End With

Exit Sub
ErrorHandler:
    Debug.Print Err.Description & " " & Err.Number & " " & Err.Source
    Exit Sub

End Sub

'---------------------------------------------------------------------------------------
' Procedure : StripAttachments
' DateTime  : 21-12-2002 23:29
' Author    : Thomas Christensen (tc@elvis.dk)
' Purpose  : Strips Attachments off incoming mail items, and saves
'            them in a user-defined directory.
'
' Dependancies: Private Sub Strip(MailitemToStrip As MailItem, SaveDir As String)
'
' Usage example:
'  Private Sub Application_NewMail()
'      StripAttachments ("F:\Attachments\")    'Remember last backslash '\'
'  End Sub
'
'---------------------------------------------------------------------------------------
'
Public Sub StripAttachments(SaveDir As String)

    On Error GoTo ErrorHandler
   
    Dim myOlApp As Outlook.Application
    Set myOlApp = Application
   
    Dim myFolder As Outlook.MAPIFolder
    Set myFolder = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
   
    Dim myMail As MailItem
    Set myMail = myFolder.Items.GetLast
   
    If TypeName(myMail) = "MailItem" Then
        Call Strip(myMail, SaveDir)
    End If
    Exit Sub
   
ErrorHandler:
    Debug.Print Err.Description & " " & Err.Number & " " & Err.Source
    Exit Sub
   
End Sub

-----------------------

Husk at rette mappenavnet til.

Bemærk at
Tools -> Macro -> Security
skal sættes til Low, ellers tillader Outlook ikke at koden udføres.

Når jeg indsætter macroen får jeg en form frem på skærmen: UserForm1.
Det kommer nok fra
"Private Sub UserForm_Click()
End Sub"
som jeg ikke kan slette.

Hvad gør jeg forkert?

Marker koden med Private Sub UserForm_Click() og slet den.
Dobbeltklik på ThisOutlookSession i venstre side, og indsæt koden.

Kan ikke finde: "ThisOutlookSession"......

1.  I Outlook. Vælg Tools -> Macro -> Visual Basic Editor
2.  I venstre side af Visual Basic editoren, dobbeltklik på Project1.
3.  Dobbeltklik på Microsoft Outlook Objects.
4.  Dobbeltklik på ThisOutlookSession.
5.  Indsæt koden.
6.  Gem.

Kunne du få det til at virke ?

Funktionen virker vel kun når outlook er åbnet, når mailen modtages? Hvordan aktiveres den efterfølgende?

ellers virker det fint :-)

Umiddelbart er den beregnet til at køre på Application_Newmail() event.

Hvis du gør følgende...
1. Åben VB editoren.
2. Vælg  Insert -> Module
3. Indsæt følgende kode i modulet

----------
'---------------------------------------------------------------------------------------
' Procedure : Strip
' DateTime  : 21-12-2002 23:26
' Author    : Thomas Christensen (tc@elvis.dk)
' Purpose  : Recursively saves attachments in user-defined directory
'            Checks for embedded mail items and saves attachments from these, if found
'---------------------------------------------------------------------------------------
'
Private Sub Strip(MailitemToStrip As MailItem, SaveDir As String)

On Error GoTo ErrorHandler

Dim i As Integer
Dim MItem As MailItem

Set MItem = MailitemToStrip
Dim SaveFilename As String
Dim msg As Object

With MItem.Attachments
   
    If .Count = 0 Then
        Exit Sub
    ElseIf .Count > 0 Then
        For i = 1 To .Count
            If Right(MItem.Attachments(i).FileName, 3) = "msg" Then
                SaveFilename = SaveDir & MItem.Attachments.Item(i).FileName
                MItem.Attachments.Item(i).SaveAsFile SaveFilename
                Set msg = Application.CreateItemFromTemplate(SaveFilename)
                Call Strip(msg, SaveDir)
               
                '' Delete temporary Outlook messages
                If Not Dir(SaveFilename) = "" Then
                    Kill SaveFilename
                End If
                Set msg = Nothing
               
            Else
                '' Save attachments that are not Outlook messages
                SaveFilename = SaveDir & MItem.Attachments.Item(i).FileName
                MItem.Attachments.Item(i).SaveAsFile SaveFilename
            End If
           
        Next i
    End If
   
End With

Exit Sub
ErrorHandler:
    Debug.Print Err.Description & " " & Err.Number & " " & Err.Source
    Exit Sub

End Sub

'---------------------------------------------------------------------------------------
' Procedure : StripAttachments
' DateTime  : 21-12-2002 23:29
' Author    : Thomas Christensen (tc@elvis.dk)
' Purpose  : Strips Attachments off incoming mail items, and saves
'            them in a user-defined directory.
'
' Dependancies: Private Sub Strip(MailitemToStrip As MailItem, SaveDir As String)
'
' Usage example:
'  Private Sub Application_NewMail()
'      StripAttachments ("F:\Attachments\")    'Remember last backslash '\'
'  End Sub
'
'---------------------------------------------------------------------------------------
'
Public Sub StripAttachments()

    On Error GoTo ErrorHandler
   
    Dim myOlApp As Outlook.Application
    Set myOlApp = Application
   
    Dim myFolder As Outlook.MAPIFolder
    Set myFolder = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
   
    Dim myMail As MailItem
    Set myMail = myFolder.Items.GetLast
   
    If TypeName(myMail) = "MailItem" Then
        Call Strip(myMail, "F:\Attachments\")
    End If
    Exit Sub
   
ErrorHandler:
    Debug.Print Err.Description & " " & Err.Number & " " & Err.Source
    Exit Sub
   
End Sub
---------------

4. Ret mappenavnet i proceduren StripAttachments()
5. Gem og luk VB editoren.
6. I Outlook vælg  Tools -> Customize  New Toolbar
7. Commands -> Macros -> Stripattachments

Burde du kunne lave en knap der aktiverer makroen.

Jeg vælger nok at køre den via ALT F11 - mange tak for hjælpen.

Jeg har alligevel lavet macroen - det virker også fint.

Godt det virker :-)