如何使用VBA导出不在主体中的Notes附件

我希望你们中的一些人可以帮助使用这些文本中的代码，我可以导出Lotus Notes邮件正文中的附件，但是我也需要导出它们，当它们不在正文中时（比如“普通”附件）。

Set LNItem = doc.GETFIRSTITEM("Body") If doc.HasEmbedded Then int_Anhang = 1 x = 0 Worksheets("Mails").Cells(j, 3).Value = 0 On Error Resume Next For Each LNAttachment In LNItem.EmbeddedObjects y = 0 AttPath = ActiveWorkbook.path & "1-Weiterleitung_Mail-Anhang" & y & "-" + LNAttachment.Name While Dir(AttPath) <> "" y = y + 1 AttPath = ActiveWorkbook.path & "1-Weiterleitung_Mail-Anhang" & y & "-" + LNAttachment.Name Wend LNAttachment.ExtractFile (AttPath) Worksheets("Mails").Cells(j, 3).Value = Worksheets("Mails").Cells(j, 3).Value + 1 Worksheets("Mails").Cells(j, 7 + x).Value = y & "-" + LNAttachment.Name x = x + 1 Next On Error GoTo Fehler Debug.Print vbNewLine End If 

有人可以帮忙吗？ 我在其他社区的问题：

ms-office-forum.net

Herber.de

这里有更多的代码：

 Dim sess As Object, db As Object, folder As Object, dc As Object, docMemo As Object, docNext As Object, LNItem As Object Dim memoSenders As Variant, memoAnhang As Variant, memoInhalt As Variant, memoLayout As Variant, LNAttachment As Variant Dim memoDate As Date, todayDate As Date Dim mail_Server As String, mail_Datei As String, memoSubject As String, AttPath As String Dim y As Integer, int_test As Integer 'On Error GoTo Fehler_Notes On Error GoTo Fehler Set sess = CreateObject("Notes.NotesSession") 'sess.Initialize ("") 'On Error GoTo Fehler mail_Server = Worksheets("Daten").Cells(2, 2).Value mail_Datei = Worksheets("Daten").Cells(2, 3).Value 'Open the mail database in notes Set db = sess.GetDatabase(mail_Server, mail_Datei) If db.IsOpen = True Then 'Already open for mail Else db.OPENMAIL End If int_test = 0 Do While Worksheets("Daten").Cells(i, 6).Value <> "" Set folder = db.GetView(Worksheets("Daten").Cells(i, 6).Value) If Worksheets("Daten").Cells(i, 9).Value <> "" Then todayDate = Worksheets("Daten").Cells(i, 9).Value Else Worksheets("Daten").Cells(i, 9).Value = "01.01.2000 00:00" todayDate = Worksheets("Daten").Cells(i, 9).Value End If Set doc = folder.GetFirstDocument Do Until doc Is Nothing Set docNext = folder.GetNextDocument(doc) 'Datum des Empfangs Worksheets("Daten").Cells(29, 2).Value = doc.GetItemValue("DeliveredDate") memoDate = Worksheets("Daten").Cells(29, 2).Value int_test = int_test + 1 int_xxx = int_xxx + 1 memoSenders = doc.GetItemValue("From") memoInhalt = doc.GetItemValue("Body") memoLayout = doc.GetItemValue("Form") memoSubject = doc.GetItemValue("Subject")(0) Worksheets("Mails").Cells(j, 1).Value = i - 2 Worksheets("Mails").Cells(j, 2).Value = memoSenders Worksheets("Mails").Cells(j, 4).Value = memoInhalt Worksheets("Mails").Cells(j, 5).Value = memoLayout Worksheets("Mails").Cells(j, 6).Value = memoSubject 'Prüfen ob Attachments innerhalb der Mail vorhanden sind Set LNItem = doc.GETFIRSTITEM("Body") If doc.HasEmbedded Then int_Anhang = 1 x = 0 Worksheets("Mails").Cells(j, 3).Value = 0 On Error Resume Next For Each LNAttachment In doc.EmbeddedObjects y = 0 AttPath = ActiveWorkbook.path & "\01-Weiterleitung_Mail-Anhang\" & y & "-" + LNAttachment.Name While Dir(AttPath) <> "" y = y + 1 AttPath = ActiveWorkbook.path & "\01-Weiterleitung_Mail-Anhang\" & y & "-" + LNAttachment.Name Wend LNAttachment.ExtractFile (AttPath) Worksheets("Mails").Cells(j, 3).Value = Worksheets("Mails").Cells(j, 3).Value + 1 Worksheets("Mails").Cells(j, 7 + x).Value = y & "-" + LNAttachment.Name x = x + 1 Next On Error GoTo Fehler Debug.Print vbNewLine End If Call doc.PutInFolder(Worksheets("Daten").Cells(6, 3).Value) Call doc.MarkRead Call doc.RemoveFromFolder(Worksheets("Daten").Cells(i, 6).Value) j = j + 1 Set doc = docNext Loop Worksheets("Daten").Cells(i, 9).Value = CStr(Format(Now, "MM/DD/YYYY hh:mm")) i = i + 1 Loop If int_test <> 0 Then i = 3 ReadNotesEmail i, j End If int_error = 0 Exit Sub 

问候

Answer 1

NotesDocument也有一个属性EmbeddedObjects 。

你可以这样使用它：

  For Each LNAttachment In doc.EmbeddedObjects ... Next 

Answer 2

我试图使Duston中的代码在Excel VBA中工作：

 Set Item = Doc.GetFirstItem("$file") If LCase(Item.Name) = "$file" Then Set FileItem = Item FileName = FileItem.Values(0) Set Object = Doc.GetAttachment(FileName) AttPath = ActiveWorkbook.path & "\01-Weiterleitung_Mail-Anhang\" & "1" & "-" ' extract the file .. Call Object.ExtractFile(AttPath & FileName) End If 

我的代码没有产生错误，脚本进入If-Case，但没有任何反应。 （“文件名”是空的）

Answer 3

检查文件名，你可以得到embededobject

这是java代码：

  String path=""; Vector fileName= session.evaluate("@AttachmentNames", document); for (int i = 0; i < fileName.size(); i++) { EmbeddedObject embeddedObject = document.getAttachment(fileName.get(i)); embeddedObject .extractFile(path+fileName.get(i)); } 

Answer 4

同时检查名为$ File的项目。 一些示例代码位于此链接： http ： //www.richardcivil.net/archives/157

尤其是：

 If Lcase( item.Name ) = "$file" Then ' get the filename ... Set FileItem = Item FileName = FileItem.Values(0) Set Object = sourceDoc.GetAttachment( FileName ) ' extract the file .. Call object.ExtractFile( tempDir & FileName ) ' upload the file .. Set newObject = attachmentBody.EmbedObject( object.Type, "", tempDir & FileName ) ' kill the file .. Kill tempDir & FileName End If