Dragging and dropping mails from outlook to VB form

I am using VB 6 to develop applications. Here's what i want:

Need to drag mails directly from outlook and drop it in a vb form which extracts its attachments if any and other details.

The problem is i can do a drag drop of any other file on drive. Even if i save the mail as a mail item i can do following things, But i need to do this directly from outlook .  So i have my outlook open i just want to drag a mail from  there and drop it in my form
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

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.

mandeliaAuthor Commented:
Please do not give me solutions to read .msg files in VB.  I can do that already.  All i nead is to read mails directly from outlook dragged and dropped in a form.  The form then will organise its attachments.

These attachments again contain mail items. The program will ten open all these attachments and read any attachment each mail item ha. Havnt tried but i think i know a solution to that.
Right.  The outlook dropped object is NOT the standard DataObject, but it DOES contain a pointer to the object.  I do not believe it is possible in VB6 to get at it, so I wrote a DLL in VC++ to do it, which I call from VB 6.  My VB 6 code is

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 Contents As String * 2000

    If (Data.GetFormat(-16370) = True) Then 'e-mail attachment
        MoveMemory DObjectAddr, ByVal ObjPtr(Data) + 16, 4
        Call DObjectHelper.SaveToFile(DObjectAddr, "C:\TempMsg.msg", Contents)
    End If
End Sub

DObjectHelper extracts the .msg content from the dropped object AND returns the first part of the body in the string Contents, C++ code forthcoming.
This is the VC++6 code for the "SaveToFile" function.  I left my notes, comments, and false starts in, they might help you.

STDMETHODIMP CDObject::SaveToFile(long pDataObjectAddress, BSTR FileName, BSTR Contents)

      //Copies the passed DataObject to a file
      HRESULT   hr = S_OK;
      IDataObject *pDataObject;
      pDataObject = (IDataObject*) pDataObjectAddress; //cast the passed pointer into a *IDataObject

      //Get the clipboard
      // Important: these strings need to be non-Unicode (don't compile UNICODE)
      unsigned short cp_format_descriptor = RegisterClipboardFormat(CFSTR_FILEDESCRIPTOR); //C0A7
      unsigned short cp_format_contents   = RegisterClipboardFormat(CFSTR_FILECONTENTS); //C0A6

      //Set up format structure for the descriptor and contents
      FORMATETC descriptor_format =
       {cp_format_descriptor, NULL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL};
      FORMATETC contents_format =  
       {cp_format_contents,   NULL, DVASPECT_CONTENT, -1, TYMED_ISTREAM};

      // Check for contents format type
      hr = pDataObject->QueryGetData(&contents_format);
      if (hr != S_OK) return hr;

      // Get the descriptor information
      STGMEDIUM storage= {0,0,0};
      STGMEDIUM ContentStorage = {0,0,0};

      contents_format.lindex = 0;
      contents_format.tymed = TYMED_ISTORAGE;
      hr = pDataObject->GetData(&contents_format, &ContentStorage);
      if (hr != S_OK) return hr;

      //Save the passed storage to the filename passed
      IStorage *FileStg;
      //hr = StgCreateDocfile(L"C:\\mtest\\MyMsg.msg",STGM_READWRITE + STGM_CREATE +STGM_SHARE_EXCLUSIVE ,0,&FileStg);
      hr = StgCreateStorageEx(FileName,STGM_READWRITE + STGM_CREATE + STGM_SHARE_EXCLUSIVE ,STGFMT_STORAGE ,0,0,0,IID_IStorage ,(void**)&FileStg);
      //hr = StgCreateStorageEx(FileName,STGM_READWRITE + STGM_CREATE + STGM_TRANSACTED  ,STGFMT_STORAGE ,0,0,0,IID_IStorage ,(void**)&FileStg);
      if (hr != S_OK) return hr;

      hr = ContentStorage.pstg->CopyTo(0,0,0,FileStg);
      if (hr != S_OK) return hr;
      hr = FileStg->Commit(STGC_DEFAULT );
      if (hr != S_OK) return hr;


      //Find the contents of the mail message and return it.

      IEnumSTATSTG* enumstg;
      STATSTG stg;
      ULONG fetched;
      ULONG bRead;
      char buffer[2000];
      IStream* stream;

      //Go through every sub storage, MAPI names them according to the MAPI Tags in MAPITags.h
      //We want the want for PR_BODY_A (plain text body), which is named 1000001E, the value for PR_BODY_A
      fetched = PR_BODY; //1000001E
      fetched = PR_BODY_A; //1000001E
      fetched = PR_BODY_W; //1000001F

      while (fetched == 1)
            OutputDebugString("type: "); OutputDebugString(itoa(stg.type,buffer,10 ));
            OutputDebugString(" Size: "); OutputDebugString(_i64toa(stg.cbSize.QuadPart ,buffer,10));
            OutputDebugStringW( stg.pwcsName);
            if (wcsstr(stg.pwcsName,L"1000001E"))
                  OutputDebugString(" Body ASCII ");
            if (stg.type == STGTY_STREAM)
                  if (wcsstr(stg.pwcsName,L"1000001E"))
                        //We found the right substorage, open it and read it into a buffer
                        OutputDebugString(" contents: ");
                        hr = FileStg->OpenStream(stg.pwcsName,NULL,STGM_READ + STGM_SHARE_EXCLUSIVE,0,&stream);
                        if (hr != S_OK) return hr;
                        if (hr != S_OK) return hr;

                        hr = stream->Release();
                        if (hr != S_OK) return hr;

                        //BSTR blah = BSTR(buffer);

                        //now save it to the passed VB String space

                        //pContents = SysAllocString( blah);
                        //pContents = &blah;

                        //pContents = blah.Copy();
                        //pContents = BSTR(buffer).Copy();
      hr = enumstg->Release();
      if (hr != S_OK) return hr;
      hr = FileStg->Commit(STGC_DEFAULT );
      if (hr != S_OK) return hr;

      hr = FileStg->Release();
      return hr;

//I tried to open a IMessage on the IStorage to use the MAPI functions to get the contents, but
//MAPIInitialize was so slow, I figured out which substg was the contents and returned that
//      hr = ::MAPIInitialize(NULL);
//      CoGetMalloc(MEMCTX_TASK, &g_pIMalloc);
//      LPMALLOC pMalloc = MAPIGetDefaultMalloc();

//      hr = FileStg->Commit(STGC_DEFAULT );

//      hr = ::OpenIMsgOnIStg(NULL,::MAPIAllocateBuffer,::MAPIAllocateMore,::MAPIFreeBuffer,pMalloc,NULL,FileStg,NULL,0,IMSG_NO_ISTG_COMMIT,&pimsg);

      //BSTR* MyBstr;
//      pimsg -> SaveChanges(KEEP_OPEN_READWRITE );
//SPropTagArray PropArray[0];
//      PropArray[0].aulPropTag = PR_BODY_A;
//      PropArray[0].aulPropTag
//      pimsg -> GetProps(
      //LPMESSAGE pMessage;
      //pMessage = pimsg->IMAPIProp;

//typedef enum tagSTGTY
//  STGTY_STORAGE      = 1,
//  STGTY_STREAM       = 2,
//  STGTY_PROPERTY     = 4
//} STGTY;


Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

>>Please do not give me solutions to read .msg files in VB.  I can do that already.

How do you do it?  My way is a pain in the butt.
mandeliaAuthor Commented:
well mine is not that big.  will paste it here tuesday. Does not have it handy
mandeliaAuthor Commented:
Thanks for this let me try it out. Really need to get this. If this works out Dinner is due
mandeliaAuthor Commented:
Hi,  Sorry was  a bit stuck up.  Dude can you do me a favour. Is there a way you can send the compiled  "DLL"  to me.

By the way here's my code to process .mg Files:

Private Function getMailMessage(ByVal FileName As String) As String

    If Dir$(FileName) = "" Then
        'nothing to read
        getMailMessage = "File " & FileName & " not found"
        Exit Function
    End If
    Set outDraftFolder = OutApp.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
    Set outMsg = OutApp.CreateItemFromTemplate(FileName)
    Dim sText As String
    If TypeOf outMsg Is Outlook.MailItem Then
        With outMsg
            sText = "A mailItem:"
            sText = sText & vbCrLf & "sender =" & .SenderName
            sText = sText & vbCrLf & "Received = " & .ReceivedTime
            sText = sText & vbCrLf & "Created = " & .CreationTime
            sText = sText & vbCrLf & "subject = " & .Subject
            sText = sText & vbCrLf & "Body:" & vbCrLf
            sText = sText & vbCrLf & .Body
            outMsg.Attachments.Item(1).SaveAsFile "c:\abc"
         End With
    End If
    getMailMessage = sText
    Set outMsg = Nothing
    Set outDraftFolder = Nothing
End Function
OK, source is in https://filedb.experts-exchange.com/incoming/ee-stuff/3217-DataObjectHelperSource.zip
Compiled DLL is in https://filedb.experts-exchange.com/incoming/ee-stuff/3218-DataObjectHelperDLL.zip

BTW EE-Stuff is a site associated with Experts-Exchange for posting files.  Login with your EE login to get the files.  They are both zips.  There are probably extra files in the source, it's been years since I touched this code, so I just grabbed everything in my project top level folder.

Thanks for the code.  I tried the MAPI route, but the "Another App is trying to access your email" warning with the forced delay was unacceptable.  My emails were still in the User's outlook, dragged & dropped into VB6,  and not a separate .msg file.  Thus I abandoned the MAPI route and didn't think about using MAPI after I extracted the .msg file since I was already into the structured storage.  Maybe I should replace the second half which pulls the .msg and replace it with MAPI, at that point Outlook should no longer complain.

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
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
Visual Basic Classic

From novice to tech pro — start learning today.