Re: How to parse a email with attachment- Miyahn please help

"Karen Middleton" wrote in message news:a5fd468a.0504272143.7eb6b3c@xxxxxxxxxxxxxxxxxx
> The code here works fine to extract the email but my problem is I want
> to extract a text file attachment that comes with the email.

Again, sorry for not a straight answer.
I can't test the new script to control Lotus Notes now.

I use this HTA + VBS to remove attached files from my mail database.

<!-- FileName: ExAttach.hta -->
<html><head>
<meta http-equiv=Content-Type content="text/html">
<title>Extract Notes Attached Files</title>
<hta:application applicationname="Extact Attachment" singleinstance="yes"
scroll="no" sysmenu="no"/><script language="vbs">
Option Explicit
Const BaseFolder = "C:\Notes"
Dim WS, FS, nSs, nWs, nDb, nVw, nVws, nDoc, Form, aOP
Dim Buf, BFolder, Folders, Folder, I, J, MServer, MFile
window.resizeto 450, 200: Set Form = document.all
Set WS = CreateObject("WScript.Shell")
If WS.Run(document.url & "/../" & "ChkNotes.vbs", , True) <> 0 Then
Alert "Notes isn't running"
Me.Close
Else
WS.AppActivate "Extract Notes Attached Files"
Set FS = CreateObject("Scripting.FileSystemObject")
If Not FS.FolderExists(BaseFolder) Then
Alert "Folder: " & BaseFolder & " will be created."
FS.CreateFolder BaseFolder
End If
End If
'
Sub SetFolder
Exit sub
Set nSs = CreateObject("Notes.NotesSession")
MServer = nSs.GetEnvironmentString("MailServer", True)
MFile = nSs.GetEnvironmentString("MailFile", True)
Set nDb = nSs.GetDataBase(MServer,MFile)
Buf = "InBox" & vbCrlf & "Sent"
nVws = nDb.Views
J = 2
For I = 1 To UBound(nVws)
If nVws(I).IsFolder And Instr(nVws(I).Name,"$") = 0 _
And Instr(nVws(I).Name,"(") = 0 Then _
Buf = Buf & vbCrLf & nVws(I).Name : J = J + 1
Next
Set nVws = Nothing
Folders = Split(Buf, vbCrLf)
For I = 0 To UBound(Folders)
Set aOP = document.createElement("option")
aOP.text = Folders(I): aOP.value = I
Form.LB1.add(aOP)
Next
Set aOP = Nothing
End Sub
'
Sub MoveAttach
I = Form.LB1.SelectedIndex: Folder = Form.LB1.Options(I).text
BFolder = FS.BuildPath(BaseFolder, Folder)
If Not FS.FolderExists(BFolder) Then FS.CreateFolder BFolder
Select Case I
Case 0
Folder = "($Inbox)"
Case 1
Folder = "($Sent)"
End Select
Set nVw = nDb.GetView(Folder)
Set nDoc = nVw.GetFirstDocument
While Not nDoc Is Nothing
If nDoc.HasEmbedded Then SaveFiles nDoc
Set nDoc = nVw.GetNextDocument(nDoc)
Wend
Set nWs = CreateObject("Notes.NotesUIWorkspace")
nWs.ViewRefresh: Set nWs = Nothing
Alert "Attachments have been extracted."
End Sub
'
Sub Finalize
Set nDoc = Nothing : Set nVw = Nothing : Set nDb = Nothing
Set nSs = Nothing : Set FS = Nothing: Set Form = Nothing
Me.Close
End Sub
'
Sub SaveFiles(nDoc)
Dim nItem, nObj, FName
Set nItem = nDoc.GetFirstItem("Body")
For Each nObj In nItem.EmbeddedObjects
If nObj.Type = 1454 Then
FName = FS.BuildPath(BFolder, nObj.Source)
If FS.FileExists(FName) Then _
FName = FS.BuildPath(BFolder, _
Replace(Time, ":", "") & "_" & nObj.Source)
nObj.ExtractFile FName
nObj.Remove
nDoc.Save True, True
End If
Next
Set nObj = Nothing : Set nItem = Nothing
End Sub
</script>
</head>
<body onload="SetFolder">
Extract all attachments from the specified mail folder.<br>
<form>
TargetFolder<br>
<select id="LB1" name="Folder">
</select>&nbsp;&nbsp;&nbsp;
<input type="button" value="Exec" onclick="MoveAttach">&nbsp;&nbsp;&nbsp;
&nbsp;&nbsp;&nbsp;<input type="button" value="Exit" onclick="Finalize">
</form></body></html>

' FileName ChkNotes.vbs
Dim RetCode
With CreateObject("WScript.Shell")
RetCode = .AppActivate("Lotus Notes")
End With
WScript.Quit(Not RetCode)

--
Miyahn (Masataka Miyashita) JPN
Microsoft MVP for Microsoft Office - Excel(Jan 2005 - Dec 2005)
HQF03250@xxxxxxxxxxx

.