Results 1 to 17 of 17

Thread: Dragging an outlook email to my VB6 app

  1. #1

    Thread Starter
    Hyperactive Member Krass's Avatar
    Join Date
    Aug 2000
    Location
    Montreal
    Posts
    488

    Dragging an outlook email to my VB6 app

    Some functionality I would like to add to an old vb6 app.

    Currently, I can drag an outlook email to the desktop and it'll create a file like this: "Email subject.msg".

    Then I'm using this code to open that file/email from vb6 and it allows me to extract some informations:
    Code:
                Dim OL As Outlook.Application
                Dim Msg As Outlook.MailItem
                
                Set OL = New Outlook.Application
                Set Msg = OL.CreateItemFromTemplate(fld & "\" & fil.Name)
                
                ' now use msg to get at the email parts
                'MsgBox Msg.Subject
                strFinal = Msg.body
                strTo = Msg.To
                strToEmail = Msg.Recipients.Item(1).Address
                Set OL = Nothing
                Set Msg = Nothing
    This is fun. But now I wanted to do the same thing, but instead of dragging the email onto the desktop, I'd be dragging it straight into my vb6 form (example: on a textbox).
    The Text1_OLEDragDrop event gets fired but I wouldn't know how to use "Data As DataObject". There could be some way of interacting with outlook in a much more sophisticated and optimized method, but honestly, if this drag-drop event could just allow me to save the .msg to, say, c:\temp\temp_email.msg, I'd be good to go with method shown above. That would completely do it.

    Any idea on how to save it to file?

    Thank you!
    Chris

  2. #2
    Frenzied Member
    Join Date
    Dec 2008
    Location
    Melbourne Australia
    Posts
    1,487

    Re: Dragging an outlook email to my VB6 app

    Can you make up a small(or trimmed) project which has all of your Outlook drag code working.
    If you attach that, I will compare it to code I have that is part of a large application.
    My code actually is designed to allow dragging of Outlook message (which has an attachment), into my VB6 program, and the attachment is copied into a folder on the hard disc.
    I notice that as an unwanted side effect, it ALSO drops the email file into the App.Path (My App.paths are not in the 'Programs' folder, they are in a folder we created). (I never use the 'Programs' folder. My programs do not require installation, so we create a folder in the C directory, for locating the VB6 program)
    Once i see your code and compare it to mine, there is a chance I can tweak your code to do similar (drop the email into your chosen folder).

    Rob

  3. #3
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Dragging an outlook email to my VB6 app

    This may interest you...


    As noted in the code rems my original ref/ link for this code has gone 404, but the first bold post in this http://www.44342.com/Visual-Basic-f948-t18515-p1.htm is by the same author (Cees Verburg) and contains similar albeit incomplete code.
    Attached Files Attached Files
    Last edited by Magic Ink; Mar 6th, 2018 at 06:57 AM.

  4. #4
    Wall Poster TysonLPrice's Avatar
    Join Date
    Sep 2002
    Location
    Columbus, Ohio
    Posts
    3,849

    Re: Dragging an outlook email to my VB6 app

    When I tried to open the demo I got:
    Attached Images Attached Images  
    Please remember next time...elections matter!

  5. #5
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Dragging an outlook email to my VB6 app

    I get the same thing (as is usual) if I double click on the vbp from inside the compressed zip folder. You must right click on the zip select Extract all and then double click the vbp from inside the uncompressed folder.

  6. #6
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,063

    Re: Dragging an outlook email to my VB6 app

    Hi,

    well I don't Drag and Drop Emails and save them.
    Perhaps you can change this it saves new Emails to a Folder....

    Code:
    Private Sub Command3_Click()
    Save_InboxFolder
    End Sub
    
    Public Function Save_InboxFolder()
      
      Dim appOL As Outlook.Application
      Dim myPost As Outlook.MailItem
      Dim nsp As Outlook.NameSpace
      Dim fld As Outlook.MAPIFolder
      Dim J As Long
      
      Set appOL = New Outlook.Application
      Set nsp = appOL.GetNamespace("MAPI")
      Set fld = nsp.GetDefaultFolder(olFolderInbox)
      For J = 1 To fld.Items.Count
        On Error Resume Next
        Set myPost = fld.Items(J)
          'If myPost.UnRead = True Then '<-- save only new Posts to the c:\temp folder
        If Err = 0 Then
          myPost.SaveAs "c:\Temp\" & Format(J, "000") & myPost.SenderName & ".msg", olMSG
        Else
          MsgBox "Item(" & J & ") Is not a Mailitem"
        End If
       ' End If
      Next
      Set myPost = Nothing
      Set fld = Nothing
      Set appOL = Nothing
    End Function

    regards
    Chris
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  7. #7
    Frenzied Member
    Join Date
    Dec 2008
    Location
    Melbourne Australia
    Posts
    1,487

    Re: Dragging an outlook email to my VB6 app

    These may help -

    This answer was provided by Edanmo the most prolific expert on Outlook drag/drop
    http://forums.devx.com/showthread.ph...ail-to-listbox

    This apparently will get the contents of the email for you
    http://www.tek-tips.com/viewthread.cfm?qid=516846

    Rob

  8. #8
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Dragging an outlook email to my VB6 app

    Using Automation of Outlook only try;

    In a new Form
    Code:
    Option Explicit
    
    'from an idea at http://www.xtremevbtalk.com/word-powerpoint-outlook-and-other-office-products/56914-drag-email-messages-outlook-vb-form.html
    
    Private Declare Function GetForegroundWindow Lib "user32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal HWND As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    
    Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
        
        Dim i&, j&
        Dim Subject$, sWindowClass$
        
        sWindowClass = GetWindowClass(GetForegroundWindow)
        'is Outlook have focus
        If InStr(1, sWindowClass, "rctrl_renwnd32") Then
            'yes it does so drag must be coming from it
            With GetObject(, "Outlook.Application") 'New Outlook.Application
                With .ActiveExplorer
                    With .Selection
                        For i = 1 To .Count     'the number of emails selected
                            Debug.Print .Item(i).Subject
                            Debug.Print .Item(i).Body
                            Debug.Print .Item(i).Attachments.Count
                            'to save the email as a msg file (with attachments)
                            ' first strip out characters which should not be included in file names
                            Subject$ = Replace$(.Item(i).Subject, ":", "")
                            Subject$ = Replace$(Subject$, "/", "")
                            Subject$ = Replace$(Subject$, "\", "")
                            'etc. there are more 'illegal' file chars e.g. *, ?, .
                            .Item(i).SaveAs CurDir$ & "\" & Subject$ & ".msg", olMSG
                            With .Item(i)
                                For j = 1 To .Attachments.Count 'the number of attachments to the email
                                    Debug.Print .Attachments(j).FileName
                                    'to save the attachments separately
                                    .Attachments(j).SaveAsFile CurDir$ & "\" & .Attachments(j).FileName
                                Next
                            End With
                        Next
                    End With
                End With
            End With
        End If
        
    End Sub
    
    Private Function GetWindowClass(ByVal HWND As Long) As String
    ' Return the class name of the specified window
        Dim sClass As String
        sClass = Space$(256)
        GetClassName HWND, sClass, 255
        GetWindowClass = Left$(sClass, InStr(sClass, vbNullChar) - 1)
    End Function
    Drag emails from Outlook onto the Form surface.
    If you want to run/ debug the above in the IDE you must run it in 'normal' mode i.e. Not as Administrator.
    Last edited by Magic Ink; Mar 7th, 2018 at 03:11 PM.

  9. #9
    Frenzied Member
    Join Date
    Dec 2008
    Location
    Melbourne Australia
    Posts
    1,487

    Re: Dragging an outlook email to my VB6 app

    I was searching my extensive collection of saved VB6 projects, and web pages, to help another thread, and came across this on one of my saved web pages. I did a Google to find the current live web page and could not find it. So I will paste the code (and credit for the source) -

    Access Each Message in Outlook Inbox
    Author: Intelligent Solutions Inc. (Featured Developer)
    Category: Office/VBA
    Type: Snippets
    Difficulty: Beginning
    Version Compatibility: Visual Basic 6

    More information: This routine gets access the outlook inbox folder on the local machine, loops through each message, reads basic info about the message, and saves the message and all of it's attachments. It is designed to give you a basic idea of what you can do with the outlook object model, especially the contents of folders. A reference to Microsoft Outlook Type Library is required.

    This code has been viewed 156880 times. (AND THAT WAS WHEN I SAVED THIS PAGE IN 2009)

    Instructions: Copy the declarations and code below and paste directly into your VB project.

    Declarations:

    '(None)

    Code:
    Code:
    Public Sub ProcessInbox()
    Dim oOutlook As Outlook.Application
    Dim oNs As Outlook.NameSpace
    Dim oFldr As Outlook.MAPIFolder
    Dim oAttachments As Outlook.Attachments
    Dim oAttachment As Outlook.Attachment
    Dim iMsgCount As Integer
    
    Dim oMessage As Outlook.MailItem
    
    Dim iCtr As Long, iAttachCnt As Long
    
    Dim sFileNames As String
    Dim aFileNames() As String
    
    
    'get reference to inbox
    Set oOutlook = New Outlook.Application
    Set oNs = oOutlook.GetNamespace("MAPI")
    Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
    Debug.Print "Total Items: "; oFldr.Items.Count
    Debug.Print "Total Unread items = " & oFldr.UnReadItemCount
    
    
    For Each oMessage In oFldr.Items
            
            With oMessage
            'basic info about message
                Debug.Print .To
                Debug.Print .CC
                Debug.Print .Subject
                Debug.Print .Body
                If .UnRead Then
                    Debug.Print "Message has not been read"
                Else
                    Debug.Print "Message has been read"
                End If
                iMsgCount = iMsgCount + 1
                'save message as text file
                .SaveAs "C:\message" & iMsgCount & ".txt", olTXT
    
                'reference and save all attachments
                With oMessage.Attachments
                    iAttachCnt = .Count
                    If iAttachCnt > 0 Then
                        For iCtr = 1 To iAttachCnt
    
                .Item(iCtr).SaveAsFile "C:\" & .Item(iCtr).FileName
    
                        Next iCtr
                    End If
                End With
            End With
            DoEvents
    
        Next oMessage    
        
        Set oAttachment = Nothing
        Set oAttachments = Nothing
        Set oMessage = Nothing
        Set oFldr = Nothing
        Set oNs = Nothing
        Set oOutlook = Nothing
        
    End Sub
    HTH,
    Rob
    PS I did come across this live page -
    http://www.freevbcode.com/ShowCode.asp?ID=4837
    Same site, same author, but page looks different.
    Not sure which is the latest/best ?

  10. #10
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Dragging an outlook email to my VB6 app

    it is easy enough to know if an outlook message has been dropped to your app, then automate outlook to process the still selected items from the outlook object currentfolder

    more of a work around than an actual solution, but the user won't notice
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  11. #11
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,063

    Re: Dragging an outlook email to my VB6 app

    Hi,

    I extenden the Code from my Post#2 and Bobbles Code from Post#9
    EDIT: I meant Post#6 and #9

    Code:
    Option Explicit
    
    Private Sub Command1_Click()
    SaveOlInboxToTemp
    End Sub
    
    Public Function SaveOlInboxToTemp()
      Dim appOL As Outlook.Application
      Dim myPost As Outlook.MailItem
      Dim nsp As Outlook.NameSpace
      Dim fld As Outlook.MAPIFolder
      Dim myFolderName As String
      
      Dim j As Long
      Dim i As Long
      Dim Anzahl As Long
      Set appOL = New Outlook.Application
      Set nsp = appOL.GetNamespace("MAPI")
      Set fld = nsp.GetDefaultFolder(olFolderInbox)
      For j = 1 To fld.Items.Count
        On Error Resume Next
        Set myPost = fld.Items(j)
        If Err = 0 Then
        'create a Folder with SenderName
             myFolderName = "C:\TestPic\" & myPost.SenderName
                        MkDir myFolderName
       
       'now save the Email to that specific Folder
        myFolderName = "C:\TestPic\" & myPost.SenderName & "\"
        myPost.SaveAs myFolderName & Format(j, "000") & " - " & myPost.SenderName & ".msg", olMSG
        End If
        Next
        
        'now save the Attachments to that specific Folder separately
         For Each myPost In fld.Items
            With myPost
              '  If .UnRead = True Then
                    Anzahl = .Attachments.Count
                    If Anzahl > 0 Then
                        myFolderName = "C:\TestPic\" & myPost.SenderName
    '                    MkDir myFolderName
                        For i = 1 To Anzahl
                            .Attachments.Item(i).SaveAsFile myFolderName & "\" & .Attachments.Item(i).FileName
                        Next i
                    End If
             '   End If
            End With
        Next myPost
      Set myPost = Nothing
      Set fld = Nothing
      Set appOL = Nothing
    End Function
    regards
    Chris
    Last edited by ChrisE; Mar 8th, 2018 at 04:27 AM.
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  12. #12
    Wall Poster TysonLPrice's Avatar
    Join Date
    Sep 2002
    Location
    Columbus, Ohio
    Posts
    3,849

    Re: Dragging an outlook email to my VB6 app

    Quote Originally Posted by ChrisE View Post
    Hi,

    I extenden the Code from my Post#2 and Bobbles Code from Post#9
    EDIT: I meant Post#6 and #9

    Code:
    Option Explicit
    
    Private Sub Command1_Click()
    SaveOlInboxToTemp
    End Sub
    
    Public Function SaveOlInboxToTemp()
      Dim appOL As Outlook.Application
      Dim myPost As Outlook.MailItem
      Dim nsp As Outlook.NameSpace
      Dim fld As Outlook.MAPIFolder
      Dim myFolderName As String
      
      Dim j As Long
      Dim i As Long
      Dim Anzahl As Long
      Set appOL = New Outlook.Application
      Set nsp = appOL.GetNamespace("MAPI")
      Set fld = nsp.GetDefaultFolder(olFolderInbox)
      For j = 1 To fld.Items.Count
        On Error Resume Next
        Set myPost = fld.Items(j)
        If Err = 0 Then
        'create a Folder with SenderName
             myFolderName = "C:\TestPic\" & myPost.SenderName
                        MkDir myFolderName
       
       'now save the Email to that specific Folder
        myFolderName = "C:\TestPic\" & myPost.SenderName & "\"
        myPost.SaveAs myFolderName & Format(j, "000") & " - " & myPost.SenderName & ".msg", olMSG
        End If
        Next
        
        'now save the Attachments to that specific Folder separately
         For Each myPost In fld.Items
            With myPost
              '  If .UnRead = True Then
                    Anzahl = .Attachments.Count
                    If Anzahl > 0 Then
                        myFolderName = "C:\TestPic\" & myPost.SenderName
    '                    MkDir myFolderName
                        For i = 1 To Anzahl
                            .Attachments.Item(i).SaveAsFile myFolderName & "\" & .Attachments.Item(i).FileName
                        Next i
                    End If
             '   End If
            End With
        Next myPost
      Set myPost = Nothing
      Set fld = Nothing
      Set appOL = Nothing
    End Function
    regards
    Chris
    Just trying it out of the box it keeps trying to create the same folder in a loop:

    'create a Folder with SenderName
    myFolderName = "C:\TestPic\" & myPost.SenderName
    MkDir myFolderName
    Please remember next time...elections matter!

  13. #13
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,063

    Re: Dragging an outlook email to my VB6 app

    Hi Tyson,

    I'm sure you could have changed it;-))

    Code:
     'create a Folder with SenderName
       myFolderName = "C:\TestPic\" & myPost.SenderName
                            For i = 1 To myFolderName
                                MkDir myFolderName
                        Next i
    EDIT:
    thinking about creating the Folders, perhaps it is better using the Contacts rather than
    the Inbox. In the Inbox the could be 5x xyz.Email@t-online.de messages.

    so the Folder creation Logic should come from what in the Contacts Folder
    if an incomming Email is not in the Contacts Folder then there should be an extra Folder -others-

    perhaps that is what you mean?

    regards
    Chris
    Last edited by ChrisE; Mar 8th, 2018 at 07:23 AM.
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  14. #14

    Thread Starter
    Hyperactive Member Krass's Avatar
    Join Date
    Aug 2000
    Location
    Montreal
    Posts
    488

    Re: Dragging an outlook email to my VB6 app

    Hello Bobbles (and everyone part of this thread).
    I'll be back to this little project of mine soon and I am still experiencing trouble doing this little simple task.

    If I drag an email from desktop to my app, it works great - I can extract Subject/Body.

    If I drag STRAIGHT from Outlook, I wouldn't quite know how to extract Subject/Body.

    One workaround could be to copy the data to C:\TempEmail.msg and go from that. Could this work?

    I've attached a very simple and small VB6 project, thank you for taking a look!
    Attached Files Attached Files
    Chris

  15. #15

    Thread Starter
    Hyperactive Member Krass's Avatar
    Join Date
    Aug 2000
    Location
    Montreal
    Posts
    488

    Re: Dragging an outlook email to my VB6 app

    Magic Ink's post (post #8) did the job!... Works nicely! Thank you!
    Chris

  16. #16
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Dragging an outlook email to my VB6 app

    Good.

  17. #17
    Fanatic Member
    Join Date
    Nov 2011
    Posts
    526

    Re: Dragging an outlook email to my VB6 app

    each method i have seen show how to loop through and save all attachments, how can i drag only one file ( if 3 files attached) and only save that one
    Last edited by k_zeon; Apr 19th, 2024 at 05:33 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width