I made an userform and macro to move Outlook-e-mails to another location.The listbox within it is filled with the Name and Location.
Everything functions good, but the command olMail.Delete leads to an error.
Why?
Code:
'status per 19 november 2023
Private Sub Commandbutton1_Click()
'Ref.: https://www.slipstick.com/developer/code-samples/save-selected-message-file/
'https://www.slipstick.com/developer/code-samples/save-selected-message-file/
Dim myItem As Object
Dim olMail As Outlook.MailItem
Dim Selection As Selection
Dim strSender As String 'Names will be shortened of extented to fix number of characters
Dim strDate As String
Dim strPath As String
Dim strSubject As String
strPath = ListBox2.List(ListBox2.ListIndex, 1)
'MsgBox strPath
'Action with loop for all selected e-mails
Set myNamespace = Application.GetNamespace("MAPI")
Set Selection = Application.ActiveExplorer.Selection
n = 0
For Each myItem In Selection
n = n + 1
Set olMail = Application.ActiveExplorer().Selection(n)
strDate = Format(myItem.CreationTime, "yyyymmdd-hhmm")
strSender = Left(myItem.Sendername & String(20, "_"), 20)
ReplaceCharsForFileName strSender, "_"
strSubject = myItem.Subject
ReplaceCharsForFileName strSubject, "_"
'Store each selected e-mail in a specified map
Debug.Print strPath & strDate & " «" & strSender & "» " & olMail.Subject & ".msg"
olMail.SaveAs strPath & strDate & " «" & strSender & "» " & olMail.Subject & ".msg", olMSG
'Delete the selected e-mail
olMail.Delete
Next 'Next mail
Userform1.hide
End Sub
'=======================================================
Private Sub ReplaceCharsForFileName(strSubjet As String, sChr As String)
sName = Replace(sName, "'", sChr)
sName = Replace(sName, "*", sChr)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub'=======================================================
Private Sub UserForm_Initialize()
'Read setup file/parameters for dropbox
file = "D:\Setup.csv"
i = 0
Userform1.ListBox2.Clear
Open file For Input As #1
Do Until EOF(1)
Line Input #1, strLine: 'Debug.Print strLine
i = i + 1
ListBox2.AddItem
ListBox2.List(i - 1, 0) = Split(strLine, ";")(0)
ListBox2.List(i - 1, 1) = Split(strLine, ";")(1)
Loop
Close #1
End Sub
'=======================================================
Private Sub ListBox2_Click()
End Sub
'=======================================================
Private Sub UserForm_Click()
End Sub
Everything functions good, but the command olMail.Delete leads to an error.
Why?