• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 335
  • Last Modified:

getting the full file name of an email attachment using CDO

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
degziebob
Asked:
degziebob
  • 4
  • 2
1 Solution
 
cquinnCommented:
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
 
cquinnCommented:
PS  You need to define your inbox with Set cdoInbox = cdoSession.Inbox after you have logged in to the session
0
 
degziebobAuthor Commented:
um....tried that but couldn't get it to work....all I really need is the one line mod for my code......
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
cquinnCommented:
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
 
cquinnCommented:
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
 
Richie_SimonettiIT OperationsCommented:
Listening...
0
 
degziebobAuthor Commented:
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

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now