使用 VBA 更改 Outlook 2013 電子郵件主題

Question

我正在使用下面的代碼將多個選定的電子郵件以標准文件命名格式保存在一個文件夾中，誰的路徑是從文本框 (textbox1) 中選擇的。 根據是否選中復選框（checkbox1）將決定運行代碼后是否刪除電子郵件。 如果未選中該復選框，則電子郵件將保存到文件夾中，但不會從 Outlook 中刪除。 如果未選中該復選框，那么我希望更改 Outlook 中的電子郵件主題，以便我知道我之前已保存該電子郵件。 除了更改電子郵件主題之外，下面的代碼幾乎可以完成我想要的一切。 如果我只選擇一封電子郵件，一切正常。 但是，如果我選擇多封電子郵件，則只會更改第一封電子郵件的主題。 任何幫助表示贊賞。

 Sub SaveIncoming()
 Dim lngC As Long
 Dim msgItem As Outlook.MailItem
 Dim strPath As String
 Dim FiledSubject As String

 On Error Resume Next
 strPath = UserForm1.TextBox1.Value
 On Error GoTo 0
 If strPath = "" Then Exit Sub
 If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

 If TypeName(Application.ActiveWindow) = "Explorer" Then
 ' save selected messages in Explorer window
 If CBool(ActiveExplorer.Selection.Count) Then
 With ActiveExplorer
 For lngC = 1 To .Selection.Count
 If .Selection(lngC).Class = olMail Then
 MsgSaver3 strPath, .Selection(lngC)

 If UserForm1.CheckBox1.Value = True Then

  .Selection(lngC).Delete

  End If

  If UserForm1.CheckBox1.Value = False Then

 FiledSubject = "[Filed" & " " & Date & "]" & " " & .Selection(lngC).Subject

 .Selection(lngC).Subject = FiledSubject

 End If

 End If
 Next lngC
 End With
 End If
 ElseIf Inspectors.Count Then
 ' save active open message
 If ActiveInspector.CurrentItem.Class = olMail Then
 MsgSaver3 strPath, ActiveInspector.CurrentItem
 End If
 End If
 End Sub

Private Sub MsgSaver3(strPath As String, msgItem As Outlook.MailItem)
  Dim intC As Integer
  Dim intD As Integer
  Dim strMsgSubj As String
  Dim strMsgFrom As String
  strMsgSubj = msgItem.Subject
  strMsgFrom = msgItem.SenderName
  ' Clean out characters from Subject which are not permitted in a file name
  For intC = 1 To Len(strMsgSubj)
  If InStr(1, ":<>""", Mid(strMsgSubj, intC, 1)) > 0 Then
  Mid(strMsgSubj, intC, 1) = "-"
  End If
  Next intC
  For intC = 1 To Len(strMsgSubj)
  If InStr(1, "\/|*?", Mid(strMsgSubj, intC, 1)) > 0 Then
  Mid(strMsgSubj, intC, 1) = "_"
  End If
  Next intC

  ' Clean out characters from Sender Name which are not permitted in a           file      name
  For intD = 1 To Len(strMsgFrom)
  If InStr(1, ":<>""", Mid(strMsgFrom, intD, 1)) > 0 Then
  Mid(strMsgFrom, intD, 1) = "-"
  End If
  Next intD
  For intD = 1 To Len(strMsgFrom)
  If InStr(1, "\/|*?", Mid(strMsgFrom, intD, 1)) > 0 Then
  Mid(strMsgFrom, intD, 1) = "_"
  End If
  Next intD
  ' add date to file name
  strMsgSubj = Format(msgItem.SentOn, "yyyy-mm-dd Hh.Nn.Ss") & " "           & "[From " & strMsgFrom & "]" & " " & strMsgSubj & ".msg"
  msgItem.SaveAs strPath & strMsgSubj
  Set msgItem = Nothing
  UserForm1.Hide
  End Sub 

Answer 1

當您刪除剩余的項目時，向上移動，因此 2 變為 1。您永遠不會處理原始項目 2。

嘗試更換

For lngC = 1 To .Selection.count

和

For lngC = .Selection.count to 1 step -1

出於同樣的原因，For Each 循環在移動或刪除時不起作用。