Mailanhänge aus Lotus Notes in Ordner ablegen

Henner · 2017-04-01T21:49:59+00:00

Guten Abend Excelaner Ich muss aus einem Postfach in Lotus Notes alle E-Mails auslesen und die Dateianhänge (*.jpg) in Ordner im Pfad "C:/images/" ablegen. Der Ordner muss aus der ersten Zahl des Betreffs der jeweiligen E-Mail bestehen. Dazu habe ich hier einiges an Code gefunden, der macht aber natürlich nicht das was ich benötige: https://dbwiki.net/wiki/VBA_Tipp:_E-Mails_mit_Attachments_aus_Notes_auslesen Hier noch einige Anforderungen: - Der Betreff jeder E-Mail hat das Format 12345678 (123456). Der Ordner, in dem die Fotos aus dieser E-Mail abgelegt werden sollen, muss in diesem Fall "12345678" heissen (Kann auch das Zeichen "-" enthalten). - Es gibt E-Mails ohne Fotos und E-Mails mit mehreren Fotos. Es kann auch mehrere E-Mails mit dem gleichen Betreff und/oder der gleichen Zahl am Anfang geben. Somit kann es vorkommen, dass der zu erstellende Ordner bereits existiert. - Die Fotos sollen unter dem Namen im jeweiligen Ordner gepseichert werden, den sie auch in der E-Mail haben (z.B.: "IMG_2319.jpg"). Ich habe den Code mal in eine Excel Datei kopiert und "Mailfile" und "Server" hinzugefügt sowie einige Korrekturen vorgenommen. Vielen vielen Dank im Voraus, schönen Abend & Gruss Henner https://www.herber.de/bbs/user/112555.xlsm _ a>

So, habe nochmals etwas angepasst...
Unter


Const savePath As String = "D:\"

musst Du noch den Pfad setzen, wo die Dateien gespeichert werden sollen. Die Unterordner (z.B. 12345678) werden automatisch generiert und das Attachment darin abgelegt.


Const myServer As String = "LNT04110/SRV/DACH041/DACHSER/DE"
Const myMailfile As String = "mail\ssoellne.nsf"
Const savePath As String = "D:\"
Public Function NotesEMailsAnzeigen() As Integer
On Error GoTo ErrBeh
Dim filePath As String
Dim intErgebnis As Integer
Dim objNotes As Object
Dim LNdb As Object
Dim LNView As Object
Dim LNDoc As Object
Dim LNItem As Object
Dim strSubject As String
Dim LNWorkspace As Object
Dim LNAttachment As Variant
intErgebnis = 0
Set objNotes = GetObject("", "Notes.NotesSession")
Set LNdb = objNotes.GETDATABASE(myServer, myMailfile)
Set LNWorkspace = CreateObject("notes.notesuiworkspace")
LNWorkspace.OpenDatabase myServer, myMailfile
If Not (LNdb Is Nothing) Then
Set LNView = LNdb.GETVIEW("$Inbox")
If Not (LNView Is Nothing) Then
Call LNView.Refresh
Set LNDoc = LNView.GETFIRSTDOCUMENT
Do While Not LNDoc Is Nothing
Set LNItem = LNDoc.GETFIRSTITEM("Subject")
On Error Resume Next
filePath = Trim(Left(LNItem.Text, InStr(1, LNItem.Text, " ", vbTextCompare)) _
)
Debug.Print filePath
MkDir savePath
MkDir savePath & "\" & filePath
On Error GoTo 0
Debug.Print LNItem.Text
Set LNItem = LNDoc.GETFIRSTITEM("Body")
If LNDoc.HasEmbedded Then
For Each LNAttachment In LNItem.EmbeddedObjects
Debug.Print LNAttachment.Name
LNAttachment.ExtractFile (savePath + "\" + filePath + "\" +  _
LNAttachment.Name)
Next
End If
Set LNDoc = LNView.GETNEXTDOCUMENT(LNDoc)
Loop
End If
End If
GoTo Ende
ErrBeh:
Err.Clear
intErgebnis = 1
Ende:
Set objNotes = Nothing
Set LNdb = Nothing
Set LNView = Nothing
Set LNItem = Nothing
Set LNWorkspace = Nothing
Set LNDoc = Nothing
NotesEMailsAnzeigen = intErgebnis
End Function

Ich nochmal...
Ich habe den Code jetzt soweit umbauen können, dass nur Fotos abgelegt werden die in ihrem Dateinamen "Q3" oder "Q4" enthalten und auch nur ein Ordner angelegt wird wenn auch Fotos abgelegt werden. Die UserForm mit dem Counter ist auch schon drin, da fehlt mir allerdings jetzt noch der Zielwert (Gesamt Anzahl E-Mails im Postfach).
Wäre super wenn Du mir die Zeile noch verraten würdest. DANKE! Gruss Henner


Public Function NotesEMailsAnzeigen() As Integer
On Error GoTo ErrBeh
Dim filePath As String
Dim intErgebnis As Integer
Dim objNotes As Object
Dim LNdb As Object
Dim LNView As Object
Dim LNDoc As Object
Dim LNItem As Object
Dim strSubject As String
Dim LNWorkspace As Object
Dim LNAttachment As Variant
Dim savePath As String
Dim myMailfile As String
Dim myServer As String
savePath = ThisWorkbook.Path & "\img2\"
myServer = "CHSDBNN12/SCH"
myMailfile = "MAIL/SCH/mailin/quickche.nsf"
intErgebnis = 0
Set objNotes = GetObject("", "Notes.NotesSession")
Set LNdb = objNotes.GETDATABASE(myServer, myMailfile)
Set LNWorkspace = CreateObject("notes.notesuiworkspace")
LNWorkspace.OpenDatabase myServer, myMailfile
UserForm1.Show vbModeless
UserForm1.Label1.Caption = 1
If Not (LNdb Is Nothing) Then
Set LNView = LNdb.GETVIEW("$Inbox")
If Not (LNView Is Nothing) Then
Call LNView.Refresh
Set LNDoc = LNView.GETFIRSTDOCUMENT
Do While Not LNDoc Is Nothing
Set LNItem = LNDoc.GETFIRSTITEM("Subject")
On Error GoTo 0
Debug.Print LNItem.Text
Set LNItem = LNDoc.GETFIRSTITEM("Body")
If LNDoc.HasEmbedded Then
For Each LNAttachment In LNItem.EmbeddedObjects
Debug.Print LNAttachment.Name
If InStr(LNAttachment.Name, "Q3") > 0 = True Or InStr(LNAttachment.Name, _
"Q4") > 0 = True Then
Set LNItem = LNDoc.GETFIRSTITEM("Subject")
On Error Resume Next
filePath = Trim(Left(LNItem.Text, InStr(1, LNItem.Text, " ",  _
vbTextCompare)))
Debug.Print filePath
MkDir savePath
MkDir savePath & "\" & filePath
LNAttachment.ExtractFile (savePath & "\" & filePath + "\" &  _
LNAttachment.Name)
End If
UserForm1.Label1.Caption = UserForm1.Label1.Caption + 1
DoEvents
Next
End If
Set LNDoc = LNView.GETNEXTDOCUMENT(LNDoc)
Loop
End If
End If
Unload UserForm1
GoTo Ende
ErrBeh:
Err.Clear
intErgebnis = 1
Ende:
Set objNotes = Nothing
Set LNdb = Nothing
Set LNView = Nothing
Set LNItem = Nothing
Set LNWorkspace = Nothing
Set LNDoc = Nothing
NotesEMailsAnzeigen = intErgebnis
End Function

Mailanhänge aus Lotus Notes in Ordner ablegen

Forumthread: Mailanhänge aus Lotus Notes in Ordner ablegen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial