Hallo zusammen,

ich hab ein großes Problem. Aufgrund bestehender IT Einstellungen kann ich keine POP3 Mails abrufen. Um das Problem zu umgehen würde ich die Mails per Imap vom Exchange abrufen. Damit ich die im meinem anderen Programm weiter nutzen kann, müsste ich diese nun automatisisert beim aufrufen als TXT in einen Ordner ablegen. Leider sind meine VBA Kenntnisse gleich null. Langes googlen und ausprobieren ergab nicht wirklich eine Lösung. Was jedoch funktioniert ist der Code hier. Jedoch nur wenn ich diesen manuell auslöse.

Ich suche also Alternativen.

1. Alternative
ich kann das VBA Script als Script über die Regeln aufrufen.

2. Alternative
Alle eingehenden Mails werden automatisch als TXT exportiert.

Vielleicht kann mir wer helfen, ich wäre mehr als dankbar dafür.

Sub SaveMailAsFile()
 Const OLTXT = 0
 Dim oMail As Outlook.MailItem
 Dim sPath As String
  Dim dtDate As Date
  Dim sName As String

  Set oMail = Application.ActiveExplorer.Selection.Item(1)
  sName = oMail.Subject
  ReplaceCharsForFileName sName, "_"

  dtDate = oMail.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "-hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".txt"

  oMail.SaveAs "C:\EDP2\Einsatzserver\test\" & sName, OLTXT
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  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