Fragen zu VB Script für Outlook!

Hallo,

ich habe mir folgendes Script für VBA besorgt:

 
Private Sub Application_NewMail()

Dim Foldername As String
Dim objIn As MAPIFolder
Dim objNewMail As MailItem

On Error Resume Next
Set objIn = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)  
For Each objNewMail In objIn.Items
With objNewMail
If .UnRead = True Then
NumberOfMails = .Attachments.Count

If NumberOfMails > 0 Then
Foldername = "C:\temp\"  
MkDir Foldername

For I = 1 To NumberOfMails
.Attachments.Item(I).SaveAsFile (Foldername) & "" & .Attachments.Item(I).FileName  

Next I
End If
End If
End With
Next objNewMail
End Sub

Kann mir einer helfen das so umzuschreiben das es die Mails (nachdem es die Anlagen in den Ordner gepackt hat) als Gelesen markiert und am besten in ein Unterordner im Posteingang verschiebt ?

Und kann man dort noch einstellen das es nur von einen bestimmten Empfänger die Anhänge in den Ordner packt ?

Danke für die Hilfe!

MfG

MTB

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 61966

Url: https://administrator.de/contentid/61966

Ausgedruckt am: 22.11.2024 um 09:11 Uhr

2 Kommentare

Neuester Kommentar

Also wenn ich Dich richtig verstanden habe dann versuchs mal damit (ungetestet!):

Private Sub Application_NewMail()

Dim Foldername As String
Dim objIn As MAPIFolder
Dim objNewMail As MailItem
Dim myDestFolder As Outlook.MAPIFolder

On Error Resume Next
Set objIn = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)  
Set myDestFolder = objIn.Folders("Verschobener Ordner")  
For Each objNewMail In objIn.Items
  With objNewMail
    If .UnRead = True Then
      .Move myDestFolder
      .UnRead = False
      If .SenderEmailAddress = "absender@jemand.de" Then  
        NumberOfMails = .Attachments.Count
        If NumberOfMails > 0 Then
          Foldername = "C:\temp\"  
          MkDir Foldername
          For I = 1 To NumberOfMails
            .Attachments.Item(I).SaveAsFile (Foldername) & "" & .Attachments.Item(I).FileName  
          Next I
        End If
      End If
    End If
  End With
Next objNewMail
End Sub