Solved

getting the full file name of an email attachment using CDO

Posted on 2001-08-22
7
314 Views
Last Modified: 2007-12-19
I've written an app in VB6 to take the attachments of incoming emails & copy them to a directory on my pc but it truncates the filenames to 8.3 which I know is a restriction with MAPI...so I read that u can do it using CDO & I found some code which I've modified but I just need to find out how the hell they got the the line in between all the ****************** below (Set oMsg = oSession.GetMessage("........")).....How do I find out this value for any email, or all of them?  All I want to do it get the attachment name for the first email in the inbox (using Outlook200/Exchange5.5)...I'm sure it's real easy but how??  if someones has a better way of doing it then please tell......all I want is the one line of code to fix the code below......

Private WithEvents oExplorer As Outlook.Explorer
Private Sub Form_Load()
Debug.Print Now
On Error Resume Next
Set oSession = CreateObject("MAPI.Session")
oSession.Logon ShowDialog:=True, NewSession:=True
Set oStores = oSession.InfoStores
thestore = oStores.Item(21).ID ' get the mbox name - only should have 1 profile
Set oStore = oSession.GetInfoStore(thestore)
Set oRoot = oStore.RootFolder
Set oFolders = oRoot.Folders
Set oFolder = oFolders.GetFirst

While Not oFolder Is Nothing
  Set oFolder = oFolders.GetNext
Wend

thestore = oFolder.Name(1).ID
Set oFolder = oSession.GetFolder(thestore)
Set oFolders = oFolder.Folders

Set oFolder = oFolders.GetFirst


While Not oFolder Is Nothing
  Set oFolder = oFolders.GetNext
Wend

Set oFolder = oSession.GetFolder(thestore)

If Not oFolder Is Nothing Then

  Set oMsgs = oFolder.Messages

  If Not oMsgs Is Nothing Then
    Set oMsg = oMsgs.GetFirst

    While Not oMsg Is Nothing
   '   Debug.Print oMsg.Subject
      'get the next item
      Set oMsg = oMsgs.GetNext
    Wend
  End If
End If

Set oMsg = oSession.GetMessage(thestore)



'clear out all your object references when done!

   MsgBox ("in")
  'get a reference to the messages collection
  Set oMsgs = oFolder.Messages

  'make sure we have some messages
  If Not oMsgs Is Nothing Then
    'move to the first message
    Set oMsg = oMsgs.GetFirst

    'while we have some messages
    'While Not oMsg Is Nothing
      Debug.Print oMsg.Subject
      'get the next item
      Set oMsg = oMsgs.GetNext
    'Wend
  End If
'*********************************************************
Set oMsg = oSession.GetMessage("000000008B5B329BDEAAD21199890008C7098B190700D16B9CA137AAD21199880008C7098B19000000000C130000400C8D180047D51199D10008C7098B190000005FD0160000", "0000000038A1BB1005E5101AA1BB08002B2A56C20000454D534D44422E444C4C00000000000000001B55FA20AA6611CD9BC800AA002FC45A0C000000474C414E543035002F6F3D4A61636F627320456E67696E656572696E672047726F757020496E632E2F6F753D476C6173676F772F636E3D526563697069656E74732F636E3D44524F424552545300")
'*********************************************************
'Set omsg = osession.GetMessage("1")


If Not oMsg Is Nothing Then

  MsgBox (oMsg.Sender.Name)
  Set oAttachments = oMsg.Attachments

  'if we have some attachments
  If Not oAttachments Is Nothing Then
    'iterate through the attachment collection
    For iLooper = 1 To oAttachments.Count
 
      MsgBox (oAttachments.Item(iLooper).Name)
    Next iLooper
  End If
End If

End Sub
0
Comment
Question by:degziebob
  • 4
  • 2
7 Comments
 
LVL 15

Expert Comment

by:cquinn
ID: 6412903
loop through each message in the messages collection.  The code below does this to check how many unread messages are in the inbox.  You should be able to adapt it.

Dim iUnread As Integer
Dim cdoMessages As MAPI.Messages
Dim cdoMessage As MAPI.Message
Dim cdoMsgFilt As MAPI.MessageFilter

CheckIncoming = 0

On Error GoTo ErrTrap

iUnread = 0
With cdoInbox
    Set cdoMessages = .Messages     'get the messages in the inbox
    Set cdoMsgFilt = cdoMessages.Filter 'Only return unread messages
    cdoMsgFilt.Unread = True
    For Each cdoMessage In cdoMessages
        DoEvents                'Yield processing
        With cdoMessage
            If UCase$(Left$(.Subject, 24)) = "OUT OF OFFICE AUTOREPLY:" Then
                .Unread = False
                .Update
            Else
                iUnread = iUnread + 1
                sSender = .Sender
                sSubject = .Subject
            End If
        End With
    Next
End With
CheckIncoming = iUnread
'Clean up to free up resources
'Set cdoInbox = Nothing
Set cdoMessage = Nothing
Set cdoMessages = Nothing
Set cdoMsgFilt = Nothing
Exit Function
ErrTrap:

CheckIncoming = 0

sCurrentLocation = "Check Incoming"
iReturn = ErrHandler(Err, Error$, errNext, sCurrentLocation)
Select Case iReturn
Case errResume
    Resume
Case errNext
    Resume Next
Case Else
    End
End Select
0
 
LVL 15

Expert Comment

by:cquinn
ID: 6412907
PS  You need to define your inbox with Set cdoInbox = cdoSession.Inbox after you have logged in to the session
0
 

Author Comment

by:degziebob
ID: 6413726
um....tried that but couldn't get it to work....all I really need is the one line mod for my code......
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 15

Expert Comment

by:cquinn
ID: 6413867
That line gets a specific message using its messageID  - presumably it was put in for debugging so that it was always working with a message for which the attachment names were known.

If you want to deal with all messages in a folder, you want to loop through them using the oMsgs.GetNext or using my For Each cdoMessage In cdoMessages loop.

You do not need to worry about the ID of individual messages, as each will be copied in turn into your oMsg object, from where you can process the attachments.

You will also need to adjust your loop so the .GetNext is at the end of the loop, or you will miss the first message in the inbox (You are finding the first with .GetFirst, then immediately doing a .Getnext which will move to the next message).

You will also need to do something to the messages you have already processed - either move them, or set them to read, so that they dont get processed again the next time you call the routine.

I do a similar thing where I check for new mail on a regular basis by calling the routine from a timer, then move the processed messages to a subfolder
0
 
LVL 15

Accepted Solution

by:
cquinn earned 299 total points
ID: 6414085
The following code will search through all unread messages in your inbox and extract any attachments.  I have not put in any serious error trapping - you can do this yourself.

When a message has been processed, its read flag is set, so it isn't processed again.  For testing purposes you can open the mailbox in outlook an right click on a message and set it as unread again.

You should have a reference to Microsoft CDO 1.21 Library, and you don't need a reference to the Outlook Object library.

Option Explicit


Public Function CheckIncomingMail() As Boolean

Dim iUnread As Integer
Dim cdoSession As MAPI.Session
Dim cdoInbox As MAPI.Folder
Dim cdoMessages As MAPI.Messages
Dim cdoMessage As MAPI.Message
Dim cdoReply As MAPI.Message
Dim cdoAttachment As MAPI.Attachment
Dim cdoMsgFilt As MAPI.MessageFilter
Dim sFileName As String

CheckIncomingMail = False

On Error GoTo ErrTrap
Set cdoSession = CreateObject("MAPI.Session")
cdoSession.Logon ShowDialog:=True, NewSession:=True

Set cdoInbox = cdoSession.Inbox
If cdoInbox Is Nothing Then
    MsgBox "Can't open Inbox....", vbCritical + vbOKOnly, "Inbox Error"
    CheckIncomingMail = False
    Exit Function
End If
'get the folder ID on the subfolder so we can move the messages
With cdoInbox
    Set cdoMessages = .Messages     'get the messages in the inbox
    Set cdoMsgFilt = cdoMessages.Filter 'Only return unread messages
    cdoMsgFilt.Unread = True
    With cdoMessages
        Set cdoMessage = .GetFirst  'get the first message
        iUnread = 0
        Do Until cdoMessage Is Nothing  'work through to the last one
            With cdoMessage
                DoEvents                'Yield processing
                For Each cdoAttachment In .Attachments
                    sFileName = Trim$(cdoAttachment.Name)
                    cdoAttachment.WriteToFile "c:\attachment directory\" & sFileName
                Next cdoAttachment
                .Unread = False
                .Update
           End With
           Set cdoMessage = .GetNext      'get the next message
        Loop
    End With
End With
'Clean up to free up resources
Set cdoInbox = Nothing
Set cdoMessages = Nothing
Set cdoMessage = Nothing
Set cdoMsgFilt = Nothing

Exit Function
ErrTrap:
    Resume Next

End Function


0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6424246
Listening...
0
 

Author Comment

by:degziebob
ID: 6431274
one comment..fantastic bit of code...worked a treat....I just modified it not to prompt a logon to the session & added a line to store the 'from' field of the attachment so it now replaces my MAPI code which did the same thing but with 8.3 names.....

many thanks....looked around A LOT to try & find out how to do this..
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now