我使用下面的代码将多个选定的电子邮件以标准文件命名格式保存在文件夹中,其路径从文本框(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
当您删除剩下的项目时,向上移动,因此2变成1。2.
尝试更换
For lngC = 1 To .Selection.count
For lngC = .Selection.count to 1 step -1
出于同样的原因,For Each循环在移动或删除时不起作用。