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循环在移动或删除时不起作用。

使用VBA更改Outlook 2013电子邮件主题

1 个答案: