We help IT Professionals succeed at work.

How to get an e-mail attachment

Hi

I need to save an e-mail atachment to a specific folder using winsock. Any suggestion

Thanks
Comment
Watch Question

Commented:
Hi akhwand

Not sure whether this is what your looking for, but have a look anyway.

http://www.freevbcode.com/ShowCode.Asp?ID=1154

If this is not good, it might be worth doing a search at

http://www.planetsourcecode.com

Hope this helps...

Commented:
This is the sample of Outlook Add-in.
On new mail event attachment will be stored to a folder...

enjoy...


Option Explicit

Const DEFAULT_PATH = "C:\Outlook Attachments\"

Public OutlookInstance        As Outlook.Application
Public WithEvents OutlEvents  As Outlook.Application
Private mFSO As New FileSystemObject

'------------------------------------------------------
'this method adds the Add-In to VB
'------------------------------------------------------
Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
   Set OutlookInstance = Application
   Set OutlEvents = OutlookInstance
End Sub

'------------------------------------------------------
'this method removes the Add-In from VB
'------------------------------------------------------
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
    Set mFSO = Nothing
    Set OutlookInstance = Nothing
End Sub

Private Sub OutlEvents_NewMail()

On Error GoTo ShowError

   Dim myNameSpace As Outlook.NameSpace
   Dim AllFolders As Outlook.Folders   ' top folders
   Dim myFolders As Outlook.Folders    ' sub folders in current folder
   Dim SubFolders As Outlook.Folders   ' sub folders of the folder
   Dim myFolder
   Dim SubFolder
   Dim myItem
   Dim subItem As MailItem

   If Not mFSO.FolderExists(DEFAULT_PATH) Then mFSO.CreateFolder (DEFAULT_PATH)
   
   Set myNameSpace = OutlookInstance.GetNamespace("MAPI")
   Set AllFolders = myNameSpace.Folders
   
   'for each folder in outlook
   For Each myFolder In AllFolders
      For Each SubFolder In myFolder.Folders
      If SubFolder.DefaultItemType = olMailItem Then
         If SubFolder.UnReadItemCount > 0 Then
            For Each myItem In SubFolder.Items
               
               If myItem.Class = olFolder Then
                  For Each subItem In myItem.Items
                     If subItem.UnRead Then GetAttachments subItem
                  Next subItem
               Else
                  If myItem.UnRead Then GetAttachments myItem
               End If
           
            Next myItem
         End If
      End If
      Next SubFolder
   Next myFolder
   
   Exit Sub
ShowError:
   App.LogEvent "Outlook Attachments Error: " & Err.Description
   Resume Next
End Sub

Private Sub GetAttachments(ByVal myItem As MailItem)
   Dim foldName As String
   Dim fldFrom As String
   Dim itm
   Dim cnt As Long
   Dim Ext As String
   Dim arExt
   Dim Attmt As Attachment
   Dim fOut As String
   
   foldName = DEFAULT_PATH
   fldFrom = myItem.SenderName & ""
   
   If Len(fldFrom) <> 0 Then fldFrom = fldFrom & "\"
   cnt = 1
     
      For Each itm In myItem.Attachments
         Set Attmt = myItem.Attachments(cnt)
         arExt = Split(Attmt.DisplayName, ".")
         Ext = arExt(UBound(arExt))
   
         If Len(Ext) = 0 Then Ext = "UNK"
         Select Case UCase(Ext)
            Case "DOC"
               foldName = foldName & "Word Docs\"
            Case "XLS"
               foldName = foldName & "EXCEL\"
            Case "TXT"
               foldName = foldName & "T E X T\"
            Case "PDF"
               foldName = foldName & "P D F\"
            Case "ZIP", "XXE", "Z"
               foldName = foldName & "Z I P\"
            Case "EXE", "VBS", "VB", "JS", "WSC"
               foldName = foldName & "E X Es\"
            Case "HTML", "HTM", "HTC", "DOTHTML"
               foldName = foldName & "HTML\"
            Case "BMP", "GIF", "JPEG", "JPG"
               foldName = foldName & "Images\"
            Case "UNK"
               foldName = foldName & "NO Extentions\"
            Case "PPT"
               foldName = foldName & "Power Point\"
            Case "XML", "XSL", "XSLT"
               foldName = foldName & "XML\"
            Case ""
            Case Else
               foldName = foldName & "Other\"
         End Select
         
         If Not mFSO.FolderExists(foldName) Then mFSO.CreateFolder (foldName)
         
         fOut = foldName & fldFrom
         'fOut = Replace(fOut, " ", "")
         fOut = Replace(fOut, ",", "")
         If Not mFSO.FolderExists(fOut) Then mFSO.CreateFolder (fOut)
         
         Attmt.SaveAsFile fOut & Attmt.DisplayName
         foldName = DEFAULT_PATH
         cnt = cnt + 1
      Next itm
               
End Sub
Richie_SimonettiIT Operations
CERTIFIED EXPERT

Commented:
Hearing...

Commented:
This is a very good example of how to use winsock, you just need to add one more class:

http://www.freevbcode.com/ShowCode.Asp?ID=3403

D'Mzzl!
RoverM

Author

Commented:
Nothing helped. I still need some code to extract the attachments from an email message. I need help desperately. I need help using WINSOCK only.
Richie_SimonettiIT Operations
CERTIFIED EXPERT

Commented:
Richie_SimonettiIT Operations
CERTIFIED EXPERT

Commented:
Richie_SimonettiIT Operations
CERTIFIED EXPERT

Commented:

Commented:
<G> Richie!
Don't forget to sleep ! ;-)

TZ!
Mark

Author

Commented:
Actually i need to get e-mails for a specific account and mail them to multiple accounts.

So right now I am using winsock to get e-mails for a specific account. I get the from part, subject part, message part which contains mime (message and attachment) and email the same mail to another account using winsock. Its working but the attachment part is not working and it shows the mime format in the message section for message itself as well as the attachments. What should I do? Any suggestions

Commented:
This question appears to have been abandoned. A Moderator will be asked to close this question after seven days, with the following recommended disposition:

delete question/refund points

If you have any comment or objection to the recommendation, please leave it here.

guidway
EE Cleanup Volunteer

Richie_SimonettiIT Operations
CERTIFIED EXPERT

Commented:
delete question? Why?

Commented:
Hi Richie!

I re-read the question and realized I read it wrong. I was trying to do cleanup at 2 in the morning my time and so I kind of was out of it. ;-) Even though you didn't give him the answer he totally wanted you put the most effort into it so I will accept that. My apologies! I will repost:

This question appears to have been abandoned. A Moderator will be asked to close this question after seven days, with the following recommended disposition:

points to Richie_Simonetti

If you have any comment or objection to the recommendation, please leave it here.

guidway
EE Cleanup Volunteer
Richie_SimonettiIT Operations
CERTIFIED EXPERT

Commented:
There is nothing against you!
I know you are doing a hard work. My comment was not to force you to change your recomendation, it was just a surprise. I prefer you PAQ it with 0 points if you like too.
Cheers

Commented:
Thanks, I'll come back in a week and make a permanent decision on it during my second (final) pass. I'm curious to see if any of the other experts reply and see what they think. I just wanted to get something posted so maybe akhwand will respond and update us on this question. I'm not sure if he is even still active though.

guidway

Commented:
---Final Pass---

This question appears to have been abandoned. A Moderator will be asked to close this question after seven days, with the following recommended disposition:

PAQ/refund points

If you have any comment or objection to the recommendation, please leave it here.

guidway
EE Cleanup Volunteer

Points refunded and placed in PAQ

Computer101
E-E Admin

Explore More ContentExplore courses, solutions, and other research materials related to this topic.