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

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
  • 4
  • 4
1 Solution
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;


Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

>>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.
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.

Join & Write a Comment

Featured Post

Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

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