Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1668to1672
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

E-Mail Betreff auslesen und in einem Ordner ablege

E-Mail Betreff auslesen und in einem Ordner ablege
19.01.2019 17:19:37
Henrik
Hallo zusammen,
ich habe folgendes Problem:
Ich bekomme eine Mail mit dem Betreff "AW: 1189/18 Bla Bla"
Die will ich im Ordner F:/scanner/in speichern und zwar mit dem Dateinamen
"1189-18 Bla Bla"
Ich glaube, die Endung ist dann .msg oder so.
Es steht immer ein Aktenzeichen im Betreff, das muss ich rausfiltern und ändern. Das Zeichen ist immer gleich aufgebaut, nämlich bis zu 5 Ziffern, dann ein Schrägstrich (der wegen des Dateinamens in einen - oder einen _ geändert werden muss und dann zwei Ziffern.
Hat jemand eine Idee, ob man das machen kann?

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: E-Mail Betreff auslesen und in einem Ordner ablege
19.01.2019 19:10:15
Luschi
Hallo
wenn ich bei Google eingebe: 'excel vba email auslesen', dann werden hunderte/tausende Lösungsvorschlage angeboten.
Hast Du Dich überhaupt mal schon mit einer einzige Variante davon beschäftigt?
fragt sich Luschi
aus klein-Paris
AW: E-Mail Betreff auslesen und in einem Ordner ablege
19.01.2019 19:25:14
Sepp
Hallo Henrik,
probier mal.
Modul Modul1
Option Explicit 
 
Sub saveMail() 
  Dim olApp As Object, objFolder As Object, objItem As Object 
  Dim strSubject As String, strFileName As String, strFullname As String 
   
  Const conSAVE_PATH      As String = "F:/scanner/in"  'Speicherpfad -Anpassen! 
  Const conMAIL_PATTERN   As String = "*###/##*" 
   
  On Error GoTo ErrorHandler 
 
  If IsFolder(conSAVE_PATH) Then 
    Set olApp = CreateObject("outlook.application") 
    Set objFolder = olApp.GetNameSpace("MAPI").GetDefaultFolder(6) 
    For Each objItem In objFolder.Items 
      strSubject = objItem.Subject 
      If InStr(1, strSubject, ":") Then strSubject = Split(strSubject, ":")(1) 
      If strSubject Like conMAIL_PATTERN Then 
        strFileName = Trim(validateFileName(strSubject, "_")) 
        If Len(strFileName) Then 
          strFullname = conSAVE_PATH & IIf(Right(conSAVE_PATH, 1) = "\", "", "\") & strFileName & ".msg" 
          If Not IsFile(strFullname) Then 
            objItem.SaveAs strFullname, 3 
          End If 
        End If 
      End If 
    Next 
  Else 
    MsgBox "Das Verzeichnis '" & conSAVE_PATH & "' existiert nicht!" 
    Err.Clear 
  End If 
 
ErrorHandler: 
 
  If Err.Number <> 0 Then 
    MsgBox "Fehler in Modul1" & vbLf & vbLf & "Prozedur:" & vbTab & "saveMail" & vbLf & _
      "Nummer:" & vbTab & Err.Number & vbLf & "Meldung:" & vbTab & Err.Description & vbLf & _
      IIf(Erl, "Zeile:" & vbTab & Erl, ""), vbExclamation, "Fehler!" 
    Err.Clear 
  End If 
 
  Set objFolder = Nothing 
  Set olApp = Nothing 
End Sub 
 
Private Function validateFileName(ByVal FileName, Optional ByVal ReplaceChar As String = "") As String 
  Dim objRegExp As Object 
     
  On Error GoTo ErrorHandler 
     
  Set objRegExp = CreateObject("vbscript.regexp") 
  With objRegExp 
    .Pattern = "[\" & Chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]" 
    .IgnoreCase = True 
    .Global = True 
    validateFileName = .Replace(FileName, ReplaceChar) 
  End With 
   
ErrorHandler: 
  Set objRegExp = Nothing 
End Function 
 
Private Function IsFolder(ByVal FolderName As String) As Boolean 
  On Error Resume Next 
  IsFolder = ((GetAttr(FolderName) And vbDirectory) = vbDirectory) 
End Function 
     
Private Function IsFile(ByVal FileName As String) As Boolean 
  On Error Resume Next 
  IsFile = ((GetAttr(FileName) And vbDirectory) <> vbDirectory) 
End Function 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige