Application.ActiveExplorer.Selection에서 항목을 드롭 할 수 있습니까?

Question

사용자가 선택한 모든 전자 메일을 선택한 다음 제목 파일의 이름으로 텍스트 파일의 이름을 텍스트 파일로 저장 한 다음 해당 전자 메일을 다른 폴더로 이동하는 Outlook VBA 매크로를 작성하려고합니다. 전망에서.

나는 그 모든 것을 작동시킬 수 있었지만, 코드는 두 줄의 여행 번호 (Trip # XXXXXXXXX로 표시됨) 만 남겨두고 이동하지 않고 다음에 선택된 전자 메일로 이동하려고합니다. 그러나 나는 그것이 작동하도록하는 것처럼 보이지는 않습니다. Exit Sub는 어려운 부분이며, 나머지 부분을 반복하고 싶습니다. 다음 oMail은 코드의 나머지 부분을 건너 뛰는 위치가 도움이되지 않는다고 말하면서 내가 끝내고 필요로하는 곳 중 하나만 필요로하고 GoTo에 필요한 것입니다.

For Each oMail In Application.ActiveExplorer.Selection 이외의 문자를 사용해야합니까?

도움을 주시면 감사하겠습니다. 감사!

나는 약 10 년 동안이 물건을 만지지 않은 채 자신의 길을 되찾은 이래로 지금 당황하고 있습니다.

이

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

이미 삭제 된 항목을 사용할 수 있지만, 나중에는 모든 메일을 이동 : 현재, 모든 것은 다음과 같다 선택에서.

즉시 유효성이 검사 된 메일을 이동할 수 있습니다.

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

당신은 단지

If intTrips > 1 Then 

과 선택에서 like

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