Thema Datum  Von Nutzer Rating
Antwort
Rot Outlook 2010 Mails Ablegen
04.06.2019 14:56:03 Dirk
NotSolved

Ansicht des Beitrags:
Von:
Dirk
Datum:
04.06.2019 14:56:03
Views:
63
Rating: Antwort:
  Ja
Thema:
Outlook 2010 Mails Ablegen

Hallo liebe VBA-Experten,

für die Mailablage in Outlook habe ich aus älteren VBA-Scripts eins zusammengestrickt, das in Outlook 2010 funktioniert. Mit folgender Ausnahme: ich möchte sowohl empfangene als auch gesendete Mails mit dem Sender- oder Empfängername ablegen. LKeider schließen sich beide gegenseitig aus. Wenn ich die fett markierte Zeile still lege kann ich immerhin Sendername ablegen. Wenn die Zeile aktiv bleibt, wird weder Sender noch Empfänger abgelegt. Über jede Unterstützung würde ich mich freuen.

 

Public Sub SaveMessageAsMsg()
Dim xMail As Outlook.MailItem
Dim xObjItem As Object
Dim xPath As String
Dim xDtDate As Date
Dim xDtDateSent As Date
Dim xName, xFileName As String
Dim xSender As String
Dim xRecipient As String
Dim Clean_Sonderzeichen As String
Dim i As Integer
 
On Error Resume Next
 
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.BrowseForFolder(0, "Select a folder:", 0, strStartingFolder)
If Not TypeName(xFolder) = "Nothing" Then
    Set xFolderItem = xFolder.self
    xFileName = xFolderItem.path & "\"
Else
    xFileName = ""
    Exit Sub
End If
 
For Each xObjItem In Outlook.ActiveExplorer.Selection
    If xObjItem.Class = olMail Then
        Set xMail = xObjItem
        xSender = xMail.SenderNAme
        xRecipient = xMail.RecipientName
        Clean_Sonderzeichen = xMail.Subject
        Const strSonderzeichen As String = "-.,:;#+ß'*?=)(/&%$§!~\}][{|"
        For i = 1 To Len(strSonderzeichen)
        xMail.Subject = Replace(xMail.Subject, Mid(strSonderzeichen, i, 1), "")
        Next i
        xDtDate = xMail.ReceivedTime
        xName = Format(xDtDate, "yymmdd" & "_", vbUseSystemDayOfWeek, _
          vbUseSystem) & xMail.Subject & "_" & xSender & ".msg"
        'xPath = xFileName + xName
        'xMail.SaveAs xPath, olMSG
    'End If
 
    'If xObjItem.Class = olMail Then
        'Set xMail = xObjItem
        xRecipient = SentMail.RecipientName
        'xName = xMail.Subject
        'Clean_Sonderzeichen = xMail.Subject
        xDtDateSent = xMail.SentOn
        xName = Format(xDtDateSent, "yymmdd" & "_", vbUseSystemDayOfWeek, _
          vbUseSystem) & xMail.Subject & "_" & xRecipient & ".msg"
        xPath = xFileName + xName
        xMail.SaveAs xPath, olMSG
    End If
    
    'Kategorie_setzen_Mail()
 
Dim olExplorer As Explorer
Dim olFolder As MAPIFolder
Dim olSelection As Selection
Set olExplorer = Application.ActiveExplorer
Set olFolder = Application.ActiveExplorer.CurrentFolder
Set olSelection = olExplorer.Selection
    
If olFolder.DefaultItemType = olMailItem Then
 If olSelection.Count = 0 Then GoTo weiter
 For x = 1 + x To olSelection.Count
  With olSelection.item(x)
   .Categories = "Abgelegt"
   .ShowCategoriesDialog
   .Save
 End With
 Next x
Else
weiter:
End If
 
 
Next
End Sub

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot Outlook 2010 Mails Ablegen
04.06.2019 14:56:03 Dirk
NotSolved