[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1729
  • Last Modified:

VBA Send message - File download

Hi,

  I am trying to download a file from an aspx webpage. The following code works fine when i run it locally on my desktop but doesn't work on a remote desktop when it clicks on the SAVE button. The handle on the file download window and on the save button are obtained  perfectly but the click event on the SAVE button does not work. Any ideas to make this code work on a remote desktop.

Example of file download window:
file download window
Public Sub File_Download_Click_Save()
    Dim hWnd As Long
    Dim timeout As Date
   
    ' Find the File Download window, waiting a maximum of 30 seconds for it to appear
    timeout = Now + TimeValue("00:00:30")

    Do
        hWnd = FindWindow("#32770", "File Download")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout
   
    If hWnd Then

        ' Find the child Save button    
        savehWnd = FindWindowEx(hWnd, 0, "Button", "&Save")
    End If
   
    If savehWnd Then
   
        ' Click the Save button
        'This part does not work on the remote desktop
        SetForegroundWindow (hWnd)
        Sleep 600  ' This sleep is required and 600 miiliseconds
        SendMessage savehWnd, BM_CLICK, 0, 0
    End If
End Sub

Thanks
0
woodmacnaps
Asked:
woodmacnaps
  • 8
  • 6
1 Solution
 
RobSampsonCommented:
Hi, instead of using window handles, see if this code (which is a VBS file) will work to download the file to a predetermined folder, entered in the script.

Regards,

Rob.

strFileToDownload = "http://yoursite.com/YourFile.zip"
strFolderToSaveTo = "C:\Temp\Files\"
WScript.Echo DownloadFile(strFileToDownload, strFolderToSaveTo)

Function DownloadFile(strURL, strDestinationFolder)
	Set objFSO = Createobject("Scripting.FileSystemObject")
	Set objShell = CreateObject("WScript.Shell")

	' Fetch the file
	On Error Resume Next
	arrXMLObjects = Array("MSXML2.ServerXMLHTTP.6.0", "MSXML2.ServerXMLHTTP.3.0", "MSXML2.ServerXMLHTTP")
	Set objXMLHTTP = Nothing
	For Each strXMLObject In arrXMLObjects
		Set objXMLHTTP = CreateObject(strXMLObject)
		If Not objXMLHTTP Is Nothing Then
			WScript.Echo "Using the " & strXMLObject & " object to retrieve " & strURL
			Exit For
		End If
	Next
	If Not objXMLHTTP Is Nothing Then 
		Err.Clear
		If Right(strDestinationFolder, 1) = "\" Then strDestinationFolder = Left(strDestinationFolder, Len(strDestinationFolder) - 1)
		strDestination = strDestinationFolder & "\" & Mid(strURL, InStrRev(strURL, "/") + 1)
		' Ignore any SSL certificate errors on the host server
		objXMLHTTP.setOption 2, 13056
		objXMLHTTP.open "GET", strURL, False
		objXMLHTTP.send()
		If Err.Number = 0 Then
			If objXMLHTTP.Status = 200 Then
				Set objADOStream = CreateObject("ADODB.Stream")
				objADOStream.Open
				objADOStream.Type = 1 'adTypeBinary
				
				objADOStream.Write objXMLHTTP.ResponseBody
				objADOStream.Position = 0    'Set the stream position to the start
				
				If objFSO.FileExists(strDestination) Then objFSO.DeleteFile strDestination, True
				
				objADOStream.SaveToFile strDestination
				objADOStream.Close
				Set objADOStream = Nothing
			End If
			Set objXMLHTTP = Nothing
			If Err.Number <> 0 Then
				strResult = "ERROR DOWNLOADING FILE: " & Err.Number & ": " & Err.Description			
				Err.Clear
			Else
				strResult = strDestination
			End If
		Else
			strResult = "ERROR DOWNLOADING FILE: " & Err.Number & ": " & Err.Description
			Err.Clear
		End If
	Else
		strResult = "ERROR CREATING HTTP OBJECT: " & Err.Number & ": " & Err.Description
	End If
	Err.Clear
	On Error Goto 0
	DownloadFile = strResult
End Function

Open in new window

0
 
woodmacnapsAuthor Commented:
Hi Rob,

The webpage from where i download this file does not give me the exact file location on the server. My download link is something like http://pubs.aar.org/pubstores/getFile.aspx?id=1767. So if i use this URL to download the file, i do not get the actual file.

Regards
0
 
RobSampsonCommented:
Hi,

It should still work if you give it a manual file name instead by changing this line:
            strDestination = strDestinationFolder & "\" & Mid(strURL, InStrRev(strURL, "/") + 1)

to something like:
            strDestination = strDestinationFolder & "\MyFile.exe"

I can't find a way to automatically find out what the filename is supposed to be.

Regards,

Rob.
0
Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

 
RobSampsonCommented:
Actually, it looks like this might work to get the intended file name

Regards,

Rob.

strFileToDownload = "http://pubs.aar.org/pubstores/getFile.aspx?id=1767"
strFolderToSaveTo = "C:\Temp\"
WScript.Echo DownloadFile(strFileToDownload, strFolderToSaveTo)

Function DownloadFile(strURL, strDestinationFolder)
	Set objFSO = Createobject("Scripting.FileSystemObject")
	Set objShell = CreateObject("WScript.Shell")

	' Fetch the file
	On Error Resume Next
	arrXMLObjects = Array("MSXML2.ServerXMLHTTP.6.0", "MSXML2.ServerXMLHTTP.3.0", "MSXML2.ServerXMLHTTP")
	Set objXMLHTTP = Nothing
	For Each strXMLObject In arrXMLObjects
		Set objXMLHTTP = CreateObject(strXMLObject)
		If Not objXMLHTTP Is Nothing Then
			WScript.Echo "Using the " & strXMLObject & " object to retrieve " & strURL
			Exit For
		End If
	Next
	If Not objXMLHTTP Is Nothing Then 
		Err.Clear
		If Right(strDestinationFolder, 1) = "\" Then strDestinationFolder = Left(strDestinationFolder, Len(strDestinationFolder) - 1)
		strDestination = strDestinationFolder & "\" & Mid(strURL, InStrRev(strURL, "/") + 1)
		' Ignore any SSL certificate errors on the host server
		objXMLHTTP.setOption 2, 13056
		objXMLHTTP.open "GET", strURL, False
		objXMLHTTP.setRequestHeader "Content-Disposition", "Attachment;FileName="
		objXMLHTTP.send()
		strFileName = Trim(objXMLHTTP.GetResponseHeader("content-disposition"))
		If Left(strFileName, 9) = "filename=" Then 
			strDestination = strDestinationFolder & "\" & Mid(strFileName, 10)
		Else
			strDestination = Replace(strDestination, "?", ":")
		End If
		If Err.Number = 0 Then
			WScript.Echo "Saving to " & strDestination		
			If objXMLHTTP.Status = 200 Then
				Set objADOStream = CreateObject("ADODB.Stream")
				objADOStream.Open
				objADOStream.Type = 1 'adTypeBinary
				
				objADOStream.Write objXMLHTTP.ResponseBody
				objADOStream.Position = 0    'Set the stream position to the start
				
				If objFSO.FileExists(strDestination) Then objFSO.DeleteFile strDestination, True
				
				objADOStream.SaveToFile strDestination
				objADOStream.Close
				Set objADOStream = Nothing
			End If
			Set objXMLHTTP = Nothing
			If Err.Number <> 0 Then
				strResult = "ERROR DOWNLOADING FILE: " & Err.Number & ": " & Err.Description			
				Err.Clear
			Else
				strResult = strDestination
			End If
		Else
			strResult = "ERROR DOWNLOADING FILE: " & Err.Number & ": " & Err.Description
			Err.Clear
		End If
	Else
		strResult = "ERROR CREATING HTTP OBJECT: " & Err.Number & ": " & Err.Description
	End If
	Err.Clear
	On Error Goto 0
	DownloadFile = strResult
End Function

Open in new window

0
 
woodmacnapsAuthor Commented:
Hi Rob,

    I tried running the code but get this message "ERROR DOWNLOADING FILE: -2147012867: A connection with the server could not be established". Normally when i download the file in Internet Explorer, i have to login into the website and then navigate to http://pubs.aar.org/pubstores/getFile.aspx?id=1767. Do you think i need to pass the login credentials to objXMLHTTP object?

Regards
0
 
RobSampsonCommented:
Above this line:
		objXMLHTTP.open "GET", strURL, False

Open in new window


add this:
		objXMLHTTP.setProxyCredentials "MyUserName", "myPassword"

Open in new window


and see if that logs in OK.

Regards,

Rob.
0
 
woodmacnapsAuthor Commented:
Rob,
  I still get the same message "ERROR DOWNLOADING FILE: -2147012867: A connection with the server could not be established".

Thanks.
0
 
RobSampsonCommented:
Sorry, wrong change....you won't need the setProxyCredentials line unless you're behind a proxy.

Instead, change this line:
		objXMLHTTP.open "GET", strURL, False 

Open in new window


to this:
		objXMLHTTP.open "GET", strURL, False, "yourusername", "password"

Open in new window


and see how it goes.

Rob.
0
 
woodmacnapsAuthor Commented:
Rob,

    I still run into the same issue. The login page to bypass before getting to the download link is https://pubs.aar.org/user/signin.aspx.

Regards
0
 
RobSampsonCommented:
Hi, does it make any difference if you have a browser open that is logged into the page before running the code?
0
 
RobSampsonCommented:
Also, does the output of the script say that it's using the MSXML2.ServerXML.6.0 object?
0
 
woodmacnapsAuthor Commented:
Hi Rob,
  Still running into the same issue. The output does say "Using the MSXML2.ServerXMLHTTP.6.0 object to retrieve http://pubs.aar.org/pubstores/getFile.aspx?id=1768" and also tried running the code with a browser logged into the webpage.

Regards
0
 
RobSampsonCommented:
Hi.  I'm sorry, I'm out of ideas on this one now.  The only other thing I can think of is that you try building an AutoIT script that will find the window handle and the button ID and click it for you.  At the very least, I guess you could use the AutoIT macro generator to identify the window handle and make sure it's #32770

Sorry.

Rob.
0
 
woodmacnapsAuthor Commented:
Hi Rob,
   Thanks for your help on this issue.

Regards..
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

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