Open Dialog IE Automation VBA - vba

I'm trying to log into a website and then upload some photos but I'm not getting any further. When the dialog opens, I can't control it programmatically. I tried to define an object as FileDialog and also to use the Application.SendKeys but it seems that the dialog isn't an application.

Hello my code is like this :
1.I define an obj as internetexplorer.aplication
2.I login and then I want to upload a photo so I click the button for upload
' all works till now
3.Now I try to interact with the dialog that let's me to choose the photos programmatically and their is my problem
Thank you Paul i'll try it today out!
Best Regards
Udar

You'll have to use a browser object with code similar to this:
.
Set browser = CreateObject("InternetExplorer.Application")
browser.Visible = True
brwser.navigate "http://stackoverflow.com/..." 'your address
Sleep 1000 'wait for 1 second
With browser.Document
Set txtUsr = .getElementsByName("Username")
Set txtPass = .getElementsByName("UserPass")
Set btnLogin = .getElementById("btnLogin")
End With
txtUsr.innerText = "User Name"
txtPass.innerText = "Password"
btnLogin.Click
.
and so on...
Use DOM, and try to avoid SendKeys if possible
"Sleep" uses an API that can be declared at the top of the module like this:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
.
Edit: I noticed that you are actually trying to interact with a dialog box, not a browser page. If so, you'll need to use Windows API functions to be able to first identify it from VBA; I'd suggest using "FindWindow":
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
and call it from VBA like this:
setMyDialog = FindWindow(vbNullString, dialogCaption)
then send keys to it; you can send the "Tab" key to move from one text box to the next
If the website is using this dialog to allow you to select multiple images it will be more challenging to automate; you'll have to use other recordings methods to simulate multiple file selections or drag-and-drop actions with the mouse
Here are some links that can help with API functions:
How To Get a Window Handle Without Specifying an Exact Title (microsoft.com)
API Declarations for VB and VBA (microsoft.com)
stackoverflow.com/questions/25098263/ (How to use FindWindow)
.
Edit for your 3 questions:
"I get an error when i use the function. Something with the 64-bit system..." - you have a 64 bit version Excel so replace this declaration
.
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
with this one:
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String
) As LongPtr
.
"When i copy the function VBA says that only comments may appear after End Sub..."
This is a declaration so it must be placed at the top of the module (before any other functions)
What should I write instead of "vbNullString" and "dialogCaption"??
You can still use "vbNullString" as the first argument, but you have to replace "dialogCaption" with the title of your dialog box
do not use quotation marks for vbNullString
do use quotation marks for the title of the dialog

Related

VBA Testing Desktop Composition

I have a few excel projects which utilize userforms. Those userforms have some code which uses Windows API calls to modify their style. An example of this can be found here:
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function DwmSetWindowAttribute Lib "dwmapi" (ByVal hwnd As Long, ByVal attr As Integer, ByRef attrValue As Integer, ByVal attrSize As Integer) As Long
Private Declare PtrSafe Function DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hwnd As Long, ByRef NEWMARGINS As MARGINS) As Long
Private UFSHADOW As Long
Private Type MARGINS
leftWidth As Long
rightWidth As Long
topHeight As Long
bottomHeight As Long
End Type
Sub all_userForms_AddShadow(frm As Object)
'Sub adds a shadow
Dim MARGINS As MARGINS
UFSHADOW = FindWindow("ThunderDFrame", vbNullString) 'Create a new Window
DwmSetWindowAttribute UFSHADOW, 2, 2, 4 'DWMAPI
'Determine Margins
With MARGINS
.rightWidth = 1
.leftWidth = 1
.topHeight = 1
.bottomHeight = 1
End With
DwmExtendFrameIntoClientArea UFSHADOW, MARGINS 'DWMAPI
'Resize
frm.Width = frm.Width - 1
frm.Height = frm.Height - 1
End Sub
The issue is that on certain clients, this will compile fine, but the result will not be displayed when the userform is initialized. I believe this is because on some clients, the windows setting "Enable Desktop Composition" is disabled by default and unable to be modified. A workaround I plan on using is to test whether or not Desktop Composition is enabled and if it is not, I will not call the sub.
My issue is that I cannot figure out how to test this. In the remarks section of this link https://msdn.microsoft.com/en-us/library/windows/desktop/aa969524(v=vs.85).aspx describes what should be returned if the DwmSetWindowAttribute function fails: DWM_E_COMPOSITIONDISABLED. I have tried setting this function equal to a few variable types, but it will not work.
Examples:
Desktop Composition Disabled
Desktop Composition Enabled
Any Suggestions? Thanks
Edit: In response to Mat's Mug's questions:
No error is thrown, it simply just does not draw the shadow.
You probably did not get the intended result as there are a few other API functions I call in relation to the "Add Shadow" sub which turn of the window caption and another which turns off the border. I can post those as well, but would make this post quite long.
I am a bit new to using windows API functions, I don't quite know your comments on the IF conditionals and VB Signatures, but I am researching it now..
As far as the bitness go, it's very likely that this tool will be accessed on both 32 and 64 bit OS. update.. I have just tested on both versions, my local machine has 64bit OS, the problem version has 32bit

Is it possible to find a window without supplying the WindowName in DNS Advanced Scripting

I am trying to find a specific window-class and want to send a custom message to it via a DNS command. I have trouble locating the window.
This is a working example for Notepad:
Declare Function FindWindow Lib "USER32" _
(ByVal lpszClassName As String, ByVal lpszWindow As String) As Long
Sub Main
Dim hWnd As Long
hWnd = FindWindow("Notepad", "Unbenannt - Editor") '<-- german title; change it
Debug.Print CStr(hWnd)
End Sub
However, It will not find the handle if I use the following:
hWnd = FindWindow("Notepad", vbNullString)
And I think it should. Here is the MSDN-Entry for it. It states, that the window name is optionally. Am I missing something?
I think that getting the window name is not an option in my case, as the target is an rich-edit-control which will not have a static window name as it send it's content rather than a static title (which is standard behavior). So I need to get this to work wthout supplying a window name.

VBA - Go to website and download file from save prompt

I've been spending the last few hours trying to figure out how to save a file onto the computer using VBA. The code template below that I found on another forum seems promising, except when I go to the desktop to access it, the .csv file has what looks like the page's source code instead of the actual file I want. This may be because when I go to the URL, it doesn't automatically download the file; rather, I am asked to save the file to a certain location (since I don't know the path name of the uploaded file on the site).
Is there any way to alter this code to accommodate this, or will I have to use a different code entirely?
Sub Test()
Dim FileNum As Long
Dim FileData() As Byte
Dim MyFile As String
Dim WHTTP As Object
On Error Resume Next
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
MyFile = "MY_URL_HERE"
WHTTP.Open "GET", MyFile, False
WHTTP.send
FileData = WHTTP.responseBody
Set WHTTP = Nothing
If Dir("C:\Users\BLAHBLAH\Desktop", vbDirectory) = Empty Then MkDir "C:\Users\BLAHBLAH\Desktop"
FileNum = FreeFile
Open "C:\Users\BLAHBLAH\Desktop\memberdatabase.csv" For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum
End Sub
Cross posts:
http://www.ozgrid.com/forum/showthread.php?t=178884
http://www.excelforum.com/excel-programming-vba-macros/925352-vba-go-to-website-and-download-file-from-save-prompt.html
I found over the years more ways how to save/download data using vba:
The firs option witch I prefer and would recommend is to use the URLDownloadToFile function of the user32 library using the following solution
The second one which was also mentioned be yourself. The point here is to use the Microsoft WinHTTP Services (Interop.WinHttp) COM library. In order to achieve this you can also add the Interop.WinHttp reference to your project link. After that you are able to use simpler notation like here link
The third option I aware is to ask the browser to save it for us and then using the Save_Over_Existing_Click_Yes function was mentioned by Santosh. In this case we open an Internet Explorer using the COM interface and navigate to the proper site. So we have to add the Microsoft Internet Controls (Interop.SHDocVw) and the Microsoft HTML Object Library (Microsoft.mshtml) references to our project in order to gain intellisense feature of the editor.
I don't like this download method because this is a work around by hacking. BUT if your IE session was already established authenticated etc. this gonna work nicely. The save function of the Internet Controls was dropped because of security concern. See for example: link
Newer the less you have to have the correct url to download what you want. If you pick the wrong one you will download something else :)
So please try to make sure the the url you use is correct by enter it in a browser. If it opens the right .csv file than your source could work too.
Also please try to send some more information: for example the url to the .csv file
Try below code :
Copied from here (Not tested)
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function SetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Private Sub Save_Over_Existing_Click_Yes()
Dim hWnd As Long
Dim timeout As Date
Debug.Print "Save_Over_Existing_Click_Yes"
'Find the Download complete window, waiting a maximum of 30 seconds for it to appear. Timeout value is dependent on the
'size of the download, so make it longer for bigger files
timeout = Now + TimeValue("00:00:30")
Do
hWnd = FindWindow(vbNullString, "Save As")
DoEvents
Sleep 200
Loop Until hWnd Or Now > timeout
Debug.Print " Save As window "; Hex(hWnd)
If hWnd Then
'Find the child Close button
hWnd = FindWindowEx(hWnd, 0, "Button", "&Yes")
Debug.Print " Yes button "; Hex(hWnd)
End If
If hWnd Then
'Click the Close button
SetForegroundWindow (hWnd)
Sleep 600 'this sleep is required and 600 miiliseconds seems to be the minimum that works
SendMessage hWnd, BM_CLICK, 0, 0
End If
End Sub

VBA to Prevent Keyboard Input While a Package Object (XML) is Read into ADODB Stream?

I am developing an application which opens and reads an XML document previously embedded in a PowerPoint presentation, or a Word document. In order to read this object (xmlFile as Object) I have to do:
xmlFile.OLEFormat.DoVerb 1
This opens the package object, and I have another subroutine that gets the open instance of Notepad.exe, and reads its contents in to ADODB stream.
An example of this procedure is available on Google Docs:
XML_Test.pptm.
During this process there is a few seconds window where the Notepad.exe gains focus, and an inadvertent keystroke may cause undesired results or error reading the XML data.
I am looking for one of two things:
Either a method to prevent the user from inadvertently inputting (via keyboard/mouse/etc) while this operation is being performed. Preferably something that does not take control of the user's machine like MouseKeyboardTest subroutine, below. Or,
A better method of extracting the XML data into a string variable.
For #1: this is the function that I found, which I am leery of using. I am wary of taking this sort of control of the users system. ##Are there any other methods that I might use?##
Private Declare Function BlockInput Lib "USER32.dll" (ByVal fBlockIt As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub MouseKeyboardTest() 'both keyboard and mouse blocked
BlockInput True ' Turns off Keyboard and Mouse
' Routine goes here
Sleep 5000 ' Optional coding
BlockInput False ' Turns on Keyboard and Mouse
End Sub
For #2: Some background, but the issue seems to be the inability to extract the embedded object reliably using any method other than DoVerb 1. Since I am dealing with an unsaved document in an application (Notepad) that is immune to my VBA skillz, this seems to be the only way to do this. Full background on that, here:
Extracting an OLEObject (XML Document) from PowerPoint VBA
As you correctly guessed in the comment above that taking the focus away from notepad will solve your problem. The below code does exactly that.
LOGIC:
A. Loop through the shape and get it's name. In your scenario it would be something like Chart Meta XML_fbc9775a-19ea-.txt
B. Use APIs like FindWindow, GetWindowTextLength, GetWindow etc to get the handle of the notepad window using partial caption.
C. Use the ShowWindow API to minimize the window
Code (tested in VBA-Powerpoint)
Paste this code in a module in the above PPTM
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias _
"GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
Private Const GW_HWNDNEXT = 2
Private Const SW_SHOWMINIMIZED = 2
Sub Sample()
Dim shp As Shape
Dim winName As String
Dim Ret As Long
For Each shp In ActivePresentation.Slides(1).Shapes
If shp.Type = msoEmbeddedOLEObject Then
winName = shp.Name
shp.OLEFormat.Activate
Exit For
End If
Next
If winName <> "" Then
Wait 1
If GetHwndFromCaption(Ret, Replace(winName, ".txt", "")) = True Then
Call ShowWindow(Ret, SW_SHOWMINIMIZED)
Else
MsgBox "Window not found!", vbOKOnly + vbExclamation
End If
End If
End Sub
Private Function GetHwndFromCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
Dim Ret As Long
Dim sStr As String
GetHwndFromCaption = False
Ret = FindWindow(vbNullString, vbNullString)
Do While Ret <> 0
sStr = String(GetWindowTextLength(Ret) + 1, Chr$(0))
GetWindowText Ret, sStr, Len(sStr)
sStr = Left$(sStr, Len(sStr) - 1)
If InStr(1, sStr, sCaption) > 0 Then
GetHwndFromCaption = True
lWnd = Ret
Exit Do
End If
Ret = GetWindow(Ret, GW_HWNDNEXT)
Loop
End Function
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
My understanding is that you have control over how XML file gets embedded into PowerPoint presentation in the first place. Here I do not quite understand why you chose to keep the data you need as contents of an embedded object.
To be sure, the task of getting those contents back is not a piece of cake. Actually, as long as there is no (simple or even moderately difficult) way to call QueryInterface and use IPersist* interfaces from VBA, there is just one way to get to contents of embedded object. The way involves following steps:
Activate an embedded object. You used OLEFormat.DoVerb 1 for that. A better way would be to call OLEFormat.Activate, but this is irrelevant for your particular problem.
Use embedded object's programming model to perform useful operations like getting contents, saving or whatever is exposed. Notepad.exe exposes no such programming model, and you resorted to WinAPI which is the best choice available.
Unfortunately, your current approach has at least 2 flaws:
The one you identified in the question (activation of notepad.exe leading to possibility of user's interference).
If a user has default program for opening .txt files other than notepad.exe, your approach is doomed.
If you do have control over how embedded object is created then better approach would be to store your XML data in some property of Shape object. I would use Shape.AlternativeText (very straightforward to use; shouldn't be used if you export your .pptm to HTML or have some different scenario where AlternativeText matters) or Shape.Tags (this one is probably the most semantically correct for the task) for that.
I don't think that blocking the user is the right approach,
If you must use a content of a notepad window, I would suggest using the SendKeys method, in order to send this combination:
SendKeys("^A^C")
Which is the equivalent of "Select All" and "Copy",
And then you could continue working "offline" on the clipboard, without fear of interference by keystrokes.
My approach, per Sid's suggestion, was to find a way to minimize the Notepad.exe. Since I already found way to get that object and close it, I figured this should not be as hard.
I add these:
Public Declare Function _
ShowWindow& Lib "user32" (ByVal hwnd As Long, _
ByVal ncmdshow As Long)
Public Const SW_MINIMIZE = 6
And then, in the FindNotepad function, right before Exit Function (so, after the Notepad has been found) I minimize the window with:
ShowWindow TopWnd, SW_MINIMIZE

How do I save a handle of ActiveDocument to a variable?

How do I get the Windows Handle of an ActiveDocument in Microsoft Word?
I wish to save the handle value to a variable.
You can use the FindWindow function to get the handle of the window in a currently active word application:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
The class name for MS Word is "OpusApp". If you have only the one Word app open then the following would return the handle to that window:
Public Function Test1()
Dim lhWnd As Long
lhWnd = FindWindow("OpusApp", vbNullString)
End Function
Note when you have multiple active Word applications, you can add the name of the window caption. For example if its saved as "Stanigator.doc", then the caption would read as "Stanigator - Microsoft Word". So:
Public Function Test2()
Dim lhWnd As Long
lhWnd = FindWindow(vbNullString, "Stanigator - Microsoft Word")
End Function
The other API that may come in handy is:
Private Declare Function GetActiveWindow Lib "user32" () As Long
Edit:
I was going to recommend the VSTO approach but based on this link that doesn't appear to be wise:
Connect Issue: VSTO API support for MS Word Main Window Handle
As Tim Williams pointed out, it's Set myDoc = ActiveDocument.