我可以从 Application.ActiveExplorer.Selection 中删除项目吗？

Question

我接收用户选择的电子邮件，然后将它们保存为文本文件，并将文本文件的名称作为主题行的一部分，然后将该电子邮件移至 Outlook 中的另一个文件夹。

我设法让所有这些工作正常进行，但我还希望代码仅在主题行中留下任何带有两个旅行号码（表示为 Trip#XXXXXXXXX）的内容，而不是移动它，而是移动到下一个选定的电子邮件。

Exit Sub 是一个硬停止，我想遍历其余的选择。 Next oMail 是我最后只被允许和需要的东西，GoTo 跳过其余代码的位置没有帮助。

我应该使用For Each oMail In Application.ActiveExplorer.Selection以外的东西吗？

整个过程如下：

Sub SaveSentEmailAsParsedSubjectAndMove()

    Dim oMail As Outlook.MailItem
    
    'Folder path and file name
        Dim strDesktop As String, strFileName As String, strFolderPath As String
    
    'Four letters at the start of a trip/PAPS/PARS and the number itself
        Dim strSCAC As String, strTripNumber As String
    
    'Trip number counter
        Dim strSubject As String, strSubject2 As String
        Dim intTrips As Integer, intTrips1 As Integer, intTrips2 As Integer
    
    'Duplicate checker
        'Dim strTestStr As String, strTestPath As String
        Dim strVersion As String, strVersionCheck As String
    
    'File saved counter
        Dim intFilesSaved As Integer
        intFilesSaved = 0
    'X carries the value for the file name, trying to save one higher in the event of a duplicate
        Dim x As Integer
    
    'Creates a text file on the desktop that will have all saved trip numbers written into it for the day.
        Dim objFSO As Object
        'Dim objFSO As New FileSystemObject
        Dim objDailyLog As Object
        'Dim objDailyLog As TextStream
        Dim strTextFilePath As String
        Dim strTextFilePathTest As String
        'Constants for reading/writing to the daily log file - Appending adds data to the end.
        'For Reading = 1
        'For Writing = 2
        'For Appending = 8
    'Variables for the timers
        'Daily log save time timer
        Dim sngStart As Single, sngEnd As Single, sngElapsed As Single
        Dim sngStart2 As Single, sngEnd2 As Single, sngElapsed2 As Single
    
    If ActiveExplorer.Selection.Count = 0 Then
        MsgBox "No files selected"
        Exit Sub
    End If
        
    'Start timer
    sngStart = Timer
    sngStart2 = Timer
    
    
    1
    
    x = 1
    
    'Set folder path - This will have to change to the J daily fax for release - J:\Fax Confirmations Daily
    
    strDesktop = Environ("userprofile")
    strFolderPath = strDesktop & "\Desktop\Test Folder\"
    If Len(Dir(strFolderPath)) = 0 Then
        MkDir strFolderPath
    Else
    End If
    'strFolderPath = "J:\Fax Confirmations Daily\"
    
    
    'Sets the path to create the record keeping text file in.
    strTextFilePath = strDesktop & "\Desktop\" & Month(Date) & " " & Day(Date) & " Saved Faxes.txt"
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
        If Len(Dir(strTextFilePath)) = 0 Then
            'MsgBox "File does NOT exist"
            Set objDailyLog = objFSO.CreateTextFile(strTextFilePath)
            objDailyLog.Close
            Else
            'MsgBox "File already exists"
        End If
    
    
        'This will save all emails selected
        For Each oMail In Application.ActiveExplorer.Selection
        
       'Gets the subject line of the mail item
        strSubject = oMail.Subject
        
        'Gets the SCAC code from the subject line, the first four characters counting from left
        strSCAC = strSubject
        strSCAC = Left(strSCAC, 4)
             
        'Counter. Stops process and returns error if there is more than one trip number detected.
        strSubject2 = oMail.Subject
        strSubject2 = Replace(strSubject2, "#", "")
        intTrips1 = Len(strSubject)
        intTrips2 = Len(strSubject2)
        intTrips = intTrips1 - intTrips2
        
        If intTrips > 1 Then
            MsgBox "You have selected an email with more than one trip number in the subject. Please only select messages with a single trip number. Thanks.", 0, "Multiple Trip Numbers Detected"
            
            GoTo 3
            'Exit Sub
        Else
                    
            'Gets the trip number, hereby defined as everything to the RIGHT of the # in the subject line
            strTripNumber = strSubject
            strTripNumber = Mid(strSubject, InStr(strSubject, "#") + 1)
                   
            'Set the File name
            strVersion = ""
            strFileName = strSCAC & strTripNumber & strVersion
    2
            'Test if file name exists. If yes, increase version number by 1 and try again.
            'If no, save and continue processing.
            
            If Len(Dir(strFolderPath & strFileName & " Sent" & strVersion & ".txt")) = 0 Then
                       
                'Save the text file with the completed file name to the previously defined folder
                 oMail.SaveAs strFolderPath & strFileName & " Sent" & strVersion & ".txt", olTXT
                 intFilesSaved = intFilesSaved + 1
                 'Open daily log file for addending (do not overwrite current data, merely add new lines to bottom)
                 Set objDailyLog = objFSO.OpenTextFile(strTextFilePath, 8, True)
                 objDailyLog.WriteLine (strFileName & " " & strVersion)
                 'Close the daily log text file
                 objDailyLog.Close
                 
                Else
                 
                    'If the file already exists, increase the version counter by 1 and try again.
                    x = x + 1
                    strVersion = " " & x
                    GoTo 2
                              
            End If
        End If
       
    x = 1
    'MoveToBackup
    
    3
    Next oMail
        
        If intTrips > 1 Then
        Set objDailyLog = objFSO.OpenTextFile(strTextFilePath, 8, True)
        objDailyLog.WriteLine (Time)
        objDailyLog.WriteLine "Saved in " & sngElapsed & " seconds"
        objDailyLog.WriteLine "Error detected: Multiple trip numbers in subject line!"
        objDailyLog.WriteBlankLines (1)
        objDailyLog.Close
        
        sngEnd2 = Timer
        sngElapsed2 = Format(sngEnd2 - sngStart2, "Fixed")
        MsgBox intFilesSaved & " file(s) saved successfully" & " in " & sngElapsed2 & " seconds", 0, "Files Saved"
        intTrips = 0
        
            Else
        
            MoveToBackup
        
            sngEnd = Timer
            sngElapsed = Format(sngEnd - sngStart, "Fixed")
        
            Set objDailyLog = objFSO.OpenTextFile(strTextFilePath, 8, True)
            objDailyLog.WriteLine (Time)
            objDailyLog.WriteLine "Saved in " & sngElapsed & " seconds"
            objDailyLog.WriteBlankLines (1)
            objDailyLog.Close
        
            sngEnd2 = Timer
            sngElapsed2 = Format(sngEnd2 - sngStart2, "Fixed")
        
            MsgBox intFilesSaved & " file(s) saved successfully" & " in " & sngElapsed2 & " seconds", 0, "Files Saved"
        End If
    
End Sub
    
'Outlook VB Macro to move selected mail item(s) to a target folder
Sub MoveToBackup()
    On Error Resume Next
    
    Dim ns As Outlook.NameSpace
    Dim moveToFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
    
    Set ns = Application.GetNamespace("MAPI")
    
    'Define path to the target folder - this was the original code,
    Set moveToFolder = ns.GetDefaultFolder(olFolderSentMail).Folders("Backup")
    
    If Application.ActiveExplorer.Selection.Count = 0 Then
       MsgBox ("No item selected")
       Exit Sub
    End If
    
    If moveToFolder Is Nothing Then
       MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
    End If
    
    For Each objItem In Application.ActiveExplorer.Selection
       If moveToFolder.DefaultItemType = olMailItem Then
          If objItem.Class = olMail Then
             objItem.Move moveToFolder
          End If
      End If
    Next
    
    Set objItem = Nothing
    Set moveToFolder = Nothing
    Set ns = Nothing
    
End Sub

Answer 1

您已经从选择中删除项目

If intTrips > 1 Then

但稍后您会移动选择中的所有邮件。

您可以立即移动经过验证的邮件。

Sub MoveValidatedMail()

    Dim oMail As mailItem

'Four letters at the start of a trip/PAPS/PARS and the number itself
    Dim strSCAC As String, strTripNumber As String

'Trip number counter
    Dim strSubject As String, strSubject2 As String
    Dim intTrips As Integer, intTrips1 As Integer, intTrips2 As Integer

'Move vaidated mail one at a time,
' within this code, rather than bulk move all mail
    Dim ns As namespace
    Dim moveToFolder As Folder
    Dim objItem As Object

    Set ns = GetNamespace("MAPI")

'Define path to the target folder

    ' If there is a typo or missing folder there would be an error.
    '  Bypass this one error only.
    On Error Resume Next
    Set moveToFolder = ns.GetDefaultFolder(olFolderSentMail).folders("Backup")
    On Error GoTo 0

    If moveToFolder Is Nothing Then
        ' Handle the bypassed error, if any
        MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
        Exit Sub
    End If

    If moveToFolder.DefaultItemType <> olMailItem Then
        MsgBox "DefaultItemType <> olMailItem!", vbOKOnly + vbExclamation, "Move Macro Error"
        Exit Sub
    End If

    If ActiveExplorer.Selection.count = 0 Then
        MsgBox "No files selected"
        Exit Sub
    End If

    For Each objItem In ActiveExplorer.Selection

        If objItem.Class = olMail Then

            Set oMail = objItem
            'Gets the subject line of the mail item
            strSubject = oMail.subject

            'Gets the SCAC code from the subject line,
            ' the first four characters counting from left
            strSCAC = strSubject
            strSCAC = Left(strSCAC, 4)

            'Counter. Stops process and returns error
            ' if there is more than one trip number detected.
            strSubject2 = oMail.subject
            strSubject2 = Replace(strSubject2, "#", "")
            intTrips1 = Len(strSubject)
            intTrips2 = Len(strSubject2)
            intTrips = intTrips1 - intTrips2

            If intTrips > 1 Then
                MsgBox "Mail not moved " & oMail.subject

            Else
                ' Move validated mail
                objItem.move moveToFolder
                MsgBox oMail.subject & " moved to " & moveToFolder

            End If

        End If

        Set oMail = Nothing

    Next objItem

    Set oMail = Nothing
    Set objItem = Nothing
    Set moveToFolder = Nothing
    Set ns = Nothing

End Sub

Answer 2

你可以使用like

If oMail.Subject like "*TRIP*TRIP*" Then