Drop Outlook email message into VB and split it up

I need to be able to drag and drop an email message from Outlook 2000, XP, 2003 onto a VB form (Which will eventually be an ActiveX OCX)
Once dropped I need to following items split out.
1. From
2. Subject
3. Body (Plain text)
4. Attachment(s) files so I can save them to hard drive

* Bonus, but not required: Entire message saveable as a .msg file

If you want to create a sample, have it display the From, Subject and body in three text boxes on the screen and save all the attachments into c:\attachment.

-This can be in VB6 or VB.net
-Please have some basic remarks in code pointing out what's happening
-This project will end up as an ocx add-in for another application. Users will drop email messages to this form on the screen and by having the parts of the email split out, I will be able to store the appropriate parts into a separate database.

I have seen some other examples on this website, but have not been sucessful at using any of the examples listed.

Thank you in advance for you assistance.  

Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

I doubt this will be an economic venture :-)
Is tis perhaps a school project?

Drag Dopping an email into vb can be dicey because VB doesn't provide a mechanism to access the underlying data in the mail message, you just get the subject line I believe.  The data object you get from VB does have a pointer to the OLEDataObject in it, however, so you can do it.   I had the same problem a while back, and with the help of some of the experts here, I got a fairly reliable system working.  I needed to create a helper object in C++ to extract the mail msg info.  See this question

I posted my resulting code there.  Note that I dropped onto an Image object, If you drop onto a different object, the offset can be different.
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

To get the values out of the email message, I parsed out the .msg text (in a lame sort of way, I don't know it's internal structure), here is the code.

Private Sub imgEMail_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim DObjectHelper As New DATAOBJECTHELPERLib.DObject
    Dim DObjectAddr As Long
    Dim i As Long
    Dim hr As Long
    Dim txtobjEMail As TextBox
    Dim txtobjFName As TextBox
    Dim txtobjLName As TextBox
    Dim FieldIndex As Integer
    Dim MsgData() As Byte
    Dim Fullname As String
    Dim FirstName As String
    Dim LastName As String
    Dim MI As String
    Dim Comments As String
    Dim Contents As String * 2000
    If (Data.GetFormat(-16370) = True) Then 'e-mail attachment
        'MsgBox "Ready"
        MoveMemory DObjectAddr, ByVal ObjPtr(Data) + 16, 4
        Call DObjectHelper.SaveToFile(DObjectAddr, "C:\TempMsg.msg", Contents)
        'MsgBox "Done"

'I read the .msg file back in so I can save it in my database/
        ReDim maildata(0) 'clear it out
        maildata = ReadMsgFile("C:\TempMsg.msg")

        imgEMail.Picture = imglstEMail.ListImages(2).Picture
        'convert the message data to string
        Dim MsgString As String
        'For i = 0 To UBound(maildata)
        '    MsgString = MsgString & Chr(maildata(i))
        'Next i
        MsgString = Contents
        'MsgBox Contents

'irevalent stuff deleted here

        'parse out key fields
        If txtobjEMail.Text = "" Then 'email field is blank
            txtobjEMail.Text = FindMsgField("From: ", MsgString)
            If Left(txtobjEMail.Text, 1) = "<" Then
                txtobjEMail.Text = Mid(txtobjEMail.Text, 2)
            End If
            If Right(txtobjEMail.Text, 1) = ">" Then
                txtobjEMail.Text = Left(txtobjEMail.Text, Len(txtobjEMail.Text) - 1)
            End If
        End If
        If txtobjFName.Text = "" Or txtobjLName.Text = "" Then
            Fullname = FindMsgField("Name: ", MsgString)
            If SplitName(Fullname, FirstName, LastName, MI) Then
                If txtobjFName.Text = "" Then
                    txtobjFName.Text = UCase(FirstName)
                End If
                If txtobjLName.Text = "" Then
                    txtobjLName.Text = UCase(LastName)
                End If
            End If
        End If
        'add a general info inquiry for the comments
        Comments = FindMsgField("Comments: ", MsgString, True)
        If Comments <> "" Then
            'create a new General Info inquiry
            Call basGlobals.LoadInquiry(Me, GENERAL_INFO)
            m_frmGeneralInfo.txtFreeText.Text = Comments
        Else 'use entire text
            'create a new General Info inquiry
            Call basGlobals.LoadInquiry(Me, GENERAL_INFO)
            m_frmGeneralInfo.txtFreeText.Text = MsgString
        End If
    End If
End Sub
Private Function FindMsgField(FieldName As String, ByRef msg As String, Optional MultiLine As Boolean = False) As String
    Dim i As Integer
    Dim j As Integer
    i = InStr(1, msg, FieldName)
    If i <= 0 Then 'not found
        FindMsgField = ""
        Exit Function
    End If
    If MultiLine Then
        'find a zero terminator
        j = InStr(i, msg, Chr(0))
        If j <= 0 Then
            'no end found, we are not going to return the whole thing because the msg has a binary footer
            FindMsgField = ""
            Exit Function
        End If
        'find the carriage return after the field
        j = InStr(i, msg, vbCrLf)
        If j <= 0 Then
            'no end found, we are not going to return the whole thing because the msg has a binary footer
            FindMsgField = ""
            Exit Function
        End If
    End If
    FindMsgField = Mid(msg, i + Len(FieldName), j - i - Len(FieldName))
End Function
RUDIGOELDIAuthor Commented:
Pegasys - Sorry, I'm new here, don't know how to make it more economic.

mlmcc - Long out of school, I only play around with vbscript, vb6 and vb.net.  Just trying to learn something I don't know how to accomplish.

JohnBPrice - Thank you very much for this script.  I am missing something however.  I pasted this code into a vb6 standar exe Form1 and I also tried an ActiveX Control form.  Do I need to add and references or components to the project?  I set OleDropMode to manual on the form, but that didn't seem to do anything either when I dropped an email message on the form.  Again, this is a new concept to me.  I've written several apps from TI994a basic to vb.net, but I can't seem to grasp this.  
Thank you,

You first need to create a data object helper in C++ based on the code in my other question I referenced.  After you build it, you have to add the reference into your vb project.  If you don't have C++ I could perhaps post my C++ project and/or the compiled DLL somewhere.

You would also need to edit the VB code to your needs, for example, I had text controls named txtobjEMail, txtobjLName, etc...
RUDIGOELDIAuthor Commented:
John, if you could email me the Project and DLLs that would be great.   I don't use C++ much at all and wasn't sure what library items to use, etc.  If you send the project I might learn something from it.  At minimum the DLLs.
<removed by modulo>
I know I might get more spam by posting this email address, but based on how much spam I get already, it can't get much worse. :)

I think you are not supposed to post your email in questions anyway, you can post it in your profile.  None the less, it's on the way and it's BIG.
I did post the original solution, in http://www.experts-exchange.com/Programming/Q_20997786.html, but he can't build it, so I sent the DLL.  Is that OK?

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
RUDIGOELDIAuthor Commented:
Sorry, I've had several faily emergencies over the holidays.  I wil attempt to give this solution a try in the next few days.  Thank you!
RUDIGOELDIAuthor Commented:
Thank you John, this will get me there once I have time to ply with it.

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.