WM_DROPFILES in other application from Excel VBA ? RRS feed

  • Question

  • I have written an excel XLSM file which writes an XML file for a windows application "Library Studio".

    When the user clicks a button in the excel workbook a VBA script writes an XML which should be opened automatically in Library Studio.

    So far I am checking if the program is already running. If the program is not running it will start the program and pass the xml filename as argument when starting the program.

    The program starts really slowly, so if the program is already running I instead use SendKeys to perform clicks in menus on Library Studio. The send keys then Perform File->open etc. to open the file in the existing instance of the program.

    The sendkeys is not super reliable and not very "pretty". The application supports Drag Drop of xml files. Is it possible to use this WM_DROPFILES to open the file automatically in Library Studio?

    That is I want to automate dropping the file onto the application without user doing anything. Is this possible?



    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

    Sub StartLS() Dim objShell, strComputer, strProcess, IsProcessRunning, LSProcess strComputer = Environ$("computername") strProcess = "SymyxStudio.exe" Dim ProgramPath As String ProgramPath = FindLSPath ' run a function that returns the program path If Dir(ProgramPath) = "" Then Exit Sub Set objShell = CreateObject("WScript.Shell") Dim Process, strObject IsProcessRunning = False strObject = "winmgmts://" & strComputer For Each Process In GetObject(strObject).InstancesOf("win32_process") If UCase(Process.Name) = UCase(strProcess) Then IsProcessRunning = True objShell.AppActivate "Library Studio", True ' activate the program objShell.AppActivate "Library Studio", True DoEvents Sleep (200) ' wait for the menu to appear SendKeys "%f{DOWN}{ENTER}", True DoEvents Sleep (200) ' wait for the menu to appear SendKeys "{ENTER}", True DoEvents Sleep (2000) ' wait for the file dialog to appear ' Application.Wait (Now + 1 / 24 / 60 / 60) SendKeys Sheets("Debug").Cells(1, 3), True 'send the filename to the file dialog DoEvents SendKeys "{ENTER}", True End If Next If Not ProgramPath = "" Then If IsProcessRunning = False Then objShell.Run ("""" & ProgramPath & """ """ & Sheets("Debug").Cells(1, 3) & """") End If End If Set objShell = Nothing End Sub


    Tuesday, December 11, 2018 9:47 AM

All replies

  • When I want to automate programs I  use AutoIT (free).  You can create an .exe file and call it from VBA.

    Tuesday, December 11, 2018 1:00 PM
  • When I want to automate programs I  use AutoIT (free).  You can create an .exe file and call it from VBA.

    Hi Mogul, 

    Thanks for the input. Since the xlsm file is to be used by many people on many different machines I prefer not the have to supply an exe file together with it. 

    I have other use cases where I need to automate tasks and I have typically used Autohotkey - but I will take a look at AutoIT.

    Another option would be to send some kind of message to the program that it should open the file.



    Tuesday, December 11, 2018 1:45 PM
  • I provide numerous Excel addins (.xlam).  The addin has alters the Excel menu to provide access to app.  I always use an installer to provide it.  I recommend the Inno installer (free).  It is very powerful and easy to use.  It makes providing extra files simple.  It also allows you to install addin in XLSTART directory.

    • Edited by mogulman52 Tuesday, December 11, 2018 2:47 PM
    Tuesday, December 11, 2018 2:38 PM
  • I made some tests based on inspiration from this site:

    Unfortunately it, the code below does not work - it returns "Run-time error 49: Bad DLL calling convention" - everything works until the "postmessage" line

    Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As Any, ByVal lpszWindow As Any) As Long
    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
    Private Declare Function PostMessage Lib "User32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Public Type POINTAPI
        X As Long
        Y As Long
    End Type
        pFiles As Long
        pt As POINTAPI
        fNC As Long
        fWode As Long
    End Type
    Sub Tests()
        Dim hWnd As Long
        Dim hWndCommandButton As Long
        Dim dummy As Long
        Dim pmem As LongPtr
        WM_DROPFILES = &H233
        hWnd = FindWindow(CStr("ATL:006CDFA8"), CLng(0))
        If hWnd <> 0 Then
            Dim hMem As Long
            Dim s As String
            Dim dropfile As DROPFILES
   = 0
   = 0
            dropfile.pFiles = 20
            dropfile.fNC = 0
            dropfile.fWode = 0
            s = "C:\temp\Source TEST.lsr" & Chr(0) & Chr(0)
            hMem = GlobalAlloc(CLng(0), 20 + Len(s))
            pmem = GlobalLock(hMem)
            CopyMem pmem, VarPtr(dropfile), 20
            CopyMem pmem + 20, VarPtr(s), Len(s)
            hWndCommandButton = FindWindowEx(hWnd, 0, CLng(0), CLng(0))
            If hWndCommandButton <> 0 Then
                dummy = PostMessage(hWnd, WM_DROPFILES, pmem, CLng(0)) ' this does not work
            End If
        End If
    End Sub

    Monday, January 20, 2020 11:45 AM