Link to home
Start Free TrialLog in
Avatar of woodmacnaps
woodmacnapsFlag for United States of America

asked on

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:
User generated image
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
Avatar of RobSampson
RobSampson
Flag of Australia image
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

Avatar of woodmacnaps
woodmacnaps
Flag of United States of America image

ASKER

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
Avatar of RobSampson
RobSampson
Flag of Australia image
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.
Avatar of RobSampson
RobSampson
Flag of Australia image
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

Avatar of woodmacnaps
woodmacnaps
Flag of United States of America image

ASKER

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
Avatar of RobSampson
RobSampson
Flag of Australia image
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.
Avatar of woodmacnaps
woodmacnaps
Flag of United States of America image

ASKER

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

Thanks.
Avatar of RobSampson
RobSampson
Flag of Australia image
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.
Avatar of woodmacnaps
woodmacnaps
Flag of United States of America image

ASKER

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
Avatar of RobSampson
RobSampson
Flag of Australia image
Hi, does it make any difference if you have a browser open that is logged into the page before running the code?
Avatar of RobSampson
RobSampson
Flag of Australia image
Also, does the output of the script say that it's using the MSXML2.ServerXML.6.0 object?
Avatar of woodmacnaps
woodmacnaps
Flag of United States of America image

ASKER

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
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of woodmacnaps
woodmacnaps
Flag of United States of America image

ASKER

Hi Rob,
   Thanks for your help on this issue.

Regards..