Hi Obelix,
> Can anyone guide me on how I am able to add a button
> in my MS Outlook 97 inbox, where this button is able
> to save the attachments in the email that I have
> highlighted ?
The "highlighted" aspect is accomplished by playing with the
ActiveInspector object, and the following code ought to get you going
on the save-attachment-to-file aspect of it:
'// ========================================================
'*********************************************************
' Function DropAttachmentsFromFolder
' Written By : Shawn K. Hall [Reliable Answers.com]
' Inputs : sOLFolderName$ = Outlook Folder name
' : sToFolder$ = Disk folder to store in
' Returns : Long = Count of attachments
' Description : Attempts to store all attachments from a
' : given outlook folder into the file system
'*********************************************************
Function DropAttachmentsFromFolder&(sOLFolderName$, _
sToFolder$)
Dim lIter&, sBuild$
On Error Resume Next
' application
Dim oa As Outlook.Application, lCount&
Set oa = CreateObject("Outlook.Application")
' namespace
Dim ns As Outlook.NameSpace
Set ns = oa.GetNamespace("MAPI")
' folder(s)
Dim fFolder As Outlook.MAPIFolder, lAttachments&
Dim pFolder As Outlook.MAPIFolder, Msg As MailItem
Set pFolder = ns.GetDefaultFolder(olFolderInbox)
Set fFolder = FindFolder(sOLFolderName, pFolder)
If Not fFolder Is Nothing Then
For Each Msg In fFolder.Items
' attachments
For lAttachments = 1 To Msg.Attachments.Count
Msg.Attachments.Item(lAttachments).SaveAsFile _
sToFolder & "\" & _
Msg.Attachments.Item(lAttachments).FileName
lCount = lCount + 1
Next
Next Msg
End If
' clean up
Set fFolder = Nothing
Set Msg = Nothing
Set ns = Nothing
'oa.Quit
Set oa = Nothing
' return
DropAttachmentsFromFolder = lCount
End Function
'*********************************************************
' Function FindFolder
' Written By : Shawn K. Hall [Reliable Answers.com]
' Inputs : sFolderName : String = Outlook Folder
' : fFromFolder = Parent folder
' Returns : MAPIFolder = Folder indicated by
' : sFolderName
' Description : This function attempts to locate a given
' : folder provided its name and possible
' : parent folders. If you do not know the
' : parent folder, pass the Inbox.
'*********************************************************
Function FindFolder(sFolderName$, _
fFromFolder) _
As MAPIFolder
Dim lIter&, rFolder As MAPIFolder
On Error GoTo FindFolder_Exit
' recurse all children folders
With fFromFolder.Folders
For lIter = 1 To .Count
If sFolderName = .Item(lIter).Name Then
' return if it is the correct one
Set rFolder = .Item(lIter)
GoTo FindFolder_Exit
ElseIf .Item(lIter).Folders.Count > 0 Then
' if it has children then recurse those now
Set rFolder = FindFolder(sFolderName, .Item(lIter))
If Not rFolder Is Nothing Then GoTo FindFolder_Exit
End If
Next lIter
End With
FindFolder_Exit:
' return
Set FindFolder = rFolder
End Function
'// ========================================================
Regards,
Shawn K. Hall
http://ReliableAnswers.com/
'// ========================================================
If it ain't broke yet, let me have a shot at it
------------------------ Yahoo! Groups Sponsor --------------------~-->
Make a clean sweep of pop-up ads. Yahoo! Companion Toolbar.
Now with Pop-Up Blocker. Get it for free!
http://us.click.yahoo.com/L5YrjA/eSIIAA/yQLSAA/k7folB/TM
--------------------------------------------------------------------~->
'// =======================================================
Rules : http://ReliableAnswers.com/List/Rules.asp
Home : http://groups.yahoo.com/group/vbHelp/
=======================================================
Post : [EMAIL PROTECTED]
Join : [EMAIL PROTECTED]
Leave : [EMAIL PROTECTED]
'// =======================================================
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/vbhelp/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
