Opgelost Delete e-mail from Outlook after storage to another location

  • Onderwerp starter Onderwerp starter keb
  • Startdatum Startdatum
Dit topic is als opgelost gemarkeerd
Status
Niet open voor verdere reacties.

keb

Gebruiker
Lid geworden
20 feb 2011
Berichten
152
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.
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?
 
Waarom in het Engels?
En waarom vertel je de betreffende foutmelding er niet bij?
 
21 dec 2023 liep ik tegen hetzelfde probleem aan en opgelost. Zie deze site
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan