Verschieben Sie eine bestimmte Anzahl von E-Mails aus geteilten Outlook-Ordner

Question

Ich bin sehr neu in VBA, also bitte nehmen Sie es einfach auf meinen Code und meine Ignoranz der richtigen Syntax, wie ich noch lerne, alle paar Tage hat die Firma, für die ich arbeite Verschieben Sie manuell eine bestimmte Anzahl von E-Mails von einem freigegebenen Netzwerkpostfach in Unterordner von Teammanagern, sie möchten, dass sie von den ältesten auf die neuesten verschoben werden, und sowohl die Manager als auch die Nummer können sich jedes Mal ändern. Ich habe sehr viel Mühe gehabt, den Code zum Laufen zu bringen, meine Lösung war bis jetzt, entweder die Nummer manuell auszuwählen und den Bewegungsbefehl zu verwenden, aber das ist langsam und sehr mühsam. Ich habe ein Skript geschrieben, um eine kleine Anzahl von E-Mails mit einer bestimmten Betreffzeile im Ordner in einen Unterordner zu verschieben, der von einer bestimmten Gruppe bearbeitet werden kann. Ich habe versucht, dies an meine derzeitige Aufgabe anzupassen, habe aber nicht viel Glück. jede Hilfe würde sehr geschätzt werden.

Sub Moverdaily() 

On Error GoTo errHandler 

Dim olApp As Outlook.Application 
Dim objNS As Outlook.Namespace 
Dim olFolder As Outlook.MAPIFolder 
Dim msg As Outlook.MailItem 
Dim manager= As Outlook.MAPIFolder 
Dim cell,start,finish,rng As Range 
Dim countE,countM As Integer 
Dim emcount, casecount, movedcount 
Set rng = Range(Range("A2"), Range("A2").End(xlDown)) 
Set olApp = Outlook.Application 
Set objNS = olApp.GetNamespace("MAPI") 
Set olFolder = objNS.Folders("Documents").Folders("Inbox") 
Set manager = objNS.Folders("Document").Folders("Inbox").Folders("Manager") 
Set finish = ThisWorkbook.Sheets("Mover").Range("I11") 
Set start = ThisWorkbook.Sheets("Mover").Range("I10") 
start.Value = Format(Now, "hh:mm:ss") 
Set emcount = Range("I12") 
Set casecount = Range("I13") 
Set movedcount = Range("I14") 

countM = 0 
countE = 0 

For i = olFolder.Items.count To 1 Step -1 
    For Each cell In rng 
    If (cell.Text = (onlyDigits(msg.Subject))) Then 
    msg.move manager 
    countM = 1 + countM 
    cell.Offset(0, 1).Value = "Moved" 
    End If 
Next 
countE = 1 + countE 
Next 

finish.Value = Format(Now, "hh:mm:ss") 
emcount.Value = countE 
casecount.Value = rng.count 
movedcount.Value = countM 
errHandler: 
    MsgBox ("Error " & Err.Number & ": " & Err.Description) 
Exit Sub 

    End Sub 

Answer 1

Erstens, verwenden Sie nicht „für jeden“ mit einer Sammlung, die Sie ändern - MailItem.Mpve eine itemn aus dieser Sammlung entfernt. Verwenden Sie stattdessen eine for i = Items.Count to 1 step -1.

Zweitens, nicht alle Artikel durchlaufen - wenn Sie bereits den Eintrag IDs (Rngarry) kennen, rufen Sie einfach Namespace.GetItemfromID.