excelvbams-wordclipboard

VBA - Save email object (OLEFormat) to file from clipboard

I'm trying to have a drag-and-drop functionality for dragging emails from Outlook into Excel and saving to a folder. This is part of a larger macro which records information and uploads it to a server. There is no easy way to do it, but I think I've almost cracked it. I'm at the stage where I can get something that works - but takes too long and is easily interruptible by the user.

My Excel VBA code performs the following steps:

This code actually works! But it's slow in that an Explorer window has to open, and worse, if the user clicks and sets the focus window elsewhere whilst Excel is waiting for the Explorer window to open, the Application.Sendkeys message goes elsewhere and the whole thing fails.

What I would like to do is just get the OLEFormat email directly from the clipboard and save it using VBA. I have found many solutions which do this for images or other file types but can't find one that works for emails. Can anybody please help?

FYI, I have earlier tried using Excel to directly save the OLEFormat email using Outlook but my security settings don't allow that. If anybody has an alternative method which works without using the clipboard, I'd be happy to consider that. My main constraint is that it must be doable from Excel using VBA.

Solution

  • Calling the WinAPI SetForegroundWindow function before using sendkeys should solve the issue of the user changing the focused window. It is also possible to pre-open the Explorer window and hide/show it using WinAPI.

    #If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
#End If

Sub SetForegroundWindowByTitle(windowTitle As String)
    Dim hWnd As LongPtr
    ' Find the window handle based on the window title
    hWnd = FindWindow(vbNullString, windowTitle)
    
    If hWnd <> 0 Then
        ' Set the found window as the foreground window
        SetForegroundWindow hWnd
    Else
        Debug.Print "Window not found: " & windowTitle
    End If
End Sub

    WebBrowser1 as a File Explorer (FileView)

    I'm not clear why MS Word is being used (presumable to capture the Drag and Drop events), or why the user doesn't simply drag the files into the File Explorer. Another alternative would be to use a WebBrower control on a Userform as a File Explorer (FileView).

    WebBrowser1 as a File Explorer

    With this simple setup, we can get a list of the Emails being dropped into the WebBrowser.

    References

    Option Explicit
Private WithEvents FolderView As Shell32.ShellFolderView

Private Sub FolderView_SelectionChanged()
    ListBox1.Clear
    Dim Item As FolderItem2
    
    For Each Item In FolderView.SelectedItems
        If Item.Type = "Outlook Item" Then
            If Item.ExtendedProperty("System.DateCreated") > Now - TimeValue("00:00:01") / 4 Then
                ListBox1.AddItem Item.Name
            End If
        End If
    Next
End Sub

Private Sub UserForm_Initialize()
    Dim Document
    
    WebBrowser1.Navigate "file:///D:/vba/test_WebBrowser"
    While WebBrowser1.Busy
        DoEvents
    Wend
    Set FolderView = WebBrowser1.Document
    
End Sub

    Note: It is possible to embed a WebBrowser control into a Worksheet but we need to modify the registry todo so.

    Download WebBrowser as a FileView Test

    Note: Set Userform ShowModal = False to allow dragging and dropping of the email or files.