Automating IE using VBA

cm2adams

New Member
Joined
Jan 16, 2006
Messages
3
I am trying to use a macro to save a website that I have opened in IE. Currently I'm using a bunch of sendkey commands. Is there any way that I can do this more simply.

I need to save the webpage to my hard drive. I also need to save it under the "Web Page, complete (*.htm;*.html)" type.

Thanks in Advance
 

Some videos you may like

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
L

Legacy 98055

Guest
See this topic: VBA - Saving a web page locally. There is a downloadable example that you can play with. I do not think you can download the file automatically without some sort of hack. There is an OLECMDID_ALLOWUILESSSAVEAS argument but it does not appear to work.
 

cm2adams

New Member
Joined
Jan 16, 2006
Messages
3
Thanks, that helped a lot!

I still have one problem though. I need to save the webpage with a specific filename. It usually works, but every 2 or 3 times it will save the webpage under the default name that IE gives it rather than the one that I supply. I've been trying to understand the code that you directed me to, but for the life of me I can't. So I haven't the slightest idea why it only works some of the time.
 
L

Legacy 98055

Guest
This is a much better implementation of the first example.
The function, ThisWorkbook.SaveWebpageAs, is very simple and contains four required arguments and two optional arguments.

ThisWorkbook.SaveWebpageAs InternetExplorer, SaveAsFileName, SaveAsType, Caller, [OverWriteExistingFile], [TimeOutInSeconds]

Required: InternetExplorer is a reference to the automated instance of Internet Explorer.

Required: SaveAsFileName is the full path of the local filename saved to disk.

Required: SaveAsType is one of the four available saveas options
HtmlComplete = "Webpage, complete (*.htm;*.html)"
ArchiveSingleFile = "Web Archive, single file (*.mht)"
HtmlOnly = "Webpage, HTML only (*.htm;*.html)"
TextOnly = "Text File (*.txt)"

Required: Caller is the parent object that contains the SaveWebpageAs function. Using this from Excel, it will nearly always be thisworkbook.

Optional: OverWriteExistingFile to overwrite the local file if it already exists. The default is false.

Optional: TimeOutInSeconds to set a timeout. The default is ten seconds.



Setting this up to work in your workbook involves a small bit of legwork.
This method involves using two separate workbooks loaded into two separate instances of Excel. Luckily, the code does all of this for you. See the next post for more details on how to set this up from scratch. This post contains the minimum instructions.

The following code must be in placed in the workbook class of the workbook that you will be using to download the files. For reference, we'll call this YourDownloader.xls.

<table width="100%" border="1" bgcolor="White" style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Option</font> <font color="#0000A0">Explicit</font>

  <font color="#0000A0">Public</font> <font color="#0000A0">Enum</font> SaveType
       HtmlComplete = 0
       ArchiveSingleFile = 1
       HtmlOnly = 2
       TextOnly = 3
  <font color="#0000A0">End</font> <font color="#0000A0">Enum</font>

  <font color="#0000A0">Public</font> <font color="#0000A0">Enum</font> DownloadResult
       NotInitialized = -1
       Success = 0
       Failure = 1
       TimedOut = 2
       FileAlreadyExists = 3
  <font color="#0000A0">End</font> <font color="#0000A0">Enum</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> SetForegroundWindow <font color="#0000A0">Lib</font> "user32" (Hwnd <font color="#0000A0">As</font> Long) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>

  <font color="#0000A0">Private</font> DownloadHelper <font color="#0000A0">As</font> Worksheet
  <font color="#0000A0">Private</font> pSaveWebpageAsResult <font color="#0000A0">As</font> DownloadResult
  <font color="#0000A0">Private</font> <font color="#0000A0">Const</font> TempFileName <font color="#0000A0">As</font> <font color="#0000A0">String</font> = "4ou5yzBtFE8mp1RHj6hO.xls"

  <font color="#0000A0">Friend</font> <font color="#0000A0">Function</font> SaveWebpageAs(Browser <font color="#0000A0">As</font> Object, SaveAsFileName <font color="#0000A0">As</font> String, _
      SaveAsType <font color="#0000A0">As</font> SaveType, Caller <font color="#0000A0">As</font> Object, <font color="#0000A0">Optional</font> OverWriteExistingFile <font color="#0000A0">As</font> Boolean, _
      <font color="#0000A0">Optional</font> TimeOutInSeconds <font color="#0000A0">As</font> <font color="#0000A0">Double</font> = 10) <font color="#0000A0">As</font> DownloadResult

       <font color="#0000A0">If</font> DownloadHelper <font color="#0000A0">Is</font> <font color="#0000A0">Nothing</font> <font color="#0000A0">Then</font> <font color="#0000A0">Set</font> DownloadHelper = GetChildRef
       DownloadHelper.Parent.SaveWebpageAs SaveAsFileName, SaveAsType, Caller, OverWriteExistingFile, TimeOutInSeconds
       Browser.ExecWB 4, 0
       SaveWebpageAs = pSaveWebpageAsResult
       AppActivate Application.Caption
  <font color="#0000A0">End</font> <font color="#0000A0">Function</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Function</font> GetChildRef() <font color="#0000A0">As</font> Worksheet
       <font color="#0000A0">Dim</font> a <font color="#0000A0">As</font> <font color="#0000A0">New</font> Application
       <font color="#0000A0">Dim</font> TempFileFullName <font color="#0000A0">As</font> String, o <font color="#0000A0">As</font> OLEObject

       TempFileFullName = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & TempFileName

       <font color="#0000A0">If</font> <font color="#0000A0">Not</font> CreateObject("Scripting.FileSystemObject").FileExists(TempFileFullName) <font color="#0000A0">Then</font>
           Application.EnableEvents = <font color="#0000A0">False</font>
           <font color="#0000A0">Set</font> o = Sheets("SaveFileAsUtility").OLEObjects(1)
           o.Enabled = <font color="#0000A0">True</font>
           o_Object.SaveAs TempFileFullName
           o_Object.Close
           o.Enabled = <font color="#0000A0">False</font>
           Application.EnableEvents = <font color="#0000A0">True</font>
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       <font color="#0000A0">With</font> a.Workbooks.Open(TempFileFullName)
           <font color="#0000A0">Set</font> GetChildRef = .Sheets(1)
       <font color="#0000A0">End</font> <font color="#0000A0">With</font>

  <font color="#0000A0">End</font> <font color="#0000A0">Function</font>

  <font color="#0000A0">Friend</font> <font color="#0000A0">Property</font> <font color="#0000A0">Get</font> SaveWebpageAsResult() <font color="#0000A0">As</font> DownloadResult
       <font color="#0000A0">If</font> DownloadHelper <font color="#0000A0">Is</font> <font color="#0000A0">Nothing</font> <font color="#0000A0">Then</font>
           SaveWebpageAsResult = NotInitialized
           <font color="#0000A0">Exit</font> <font color="#0000A0">Property</font>
       <font color="#0000A0">Else</font>
           SaveWebpageAsResult = pSaveWebpageAsResult
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>
  <font color="#0000A0">End</font> <font color="#0000A0">Property</font>

  <font color="#0000A0">Public</font> <font color="#0000A0">Sub</font> UpdateSaveWebpageAsResult(Value <font color="#0000A0">As</font> DownloadResult, WriteAccessCode <font color="#0000A0">As</font> String)
       <font color="#0000A0">If</font> DownloadHelper <font color="#0000A0">Is</font> <font color="#0000A0">Nothing</font> <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
       <font color="#0000A0">If</font> <font color="#0000A0">Not</font> DownloadHelper.Parent.ValidWriteAccessCode(WriteAccessCode) <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
       pSaveWebpageAsResult = Value
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> Workbook_BeforeClose(Cancel <font color="#0000A0">As</font> Boolean)
       <font color="#0000A0">On</font> <font color="#0000A0">Error</font> <font color="#0000A0">Resume</font> <font color="#0000A0">Next</font>
       DownloadHelper.Parent.Parent.Quit
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

</FONT></td></tr></table><button onclick='document.all("102220069948218").value=document.all("102220069948218").value.replace(/<br \/>\s\s/g,"");document.all("102220069948218").value=document.all("102220069948218").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("102220069948218").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="102220069948218" wrap="virtual">
Option Explicit

Public Enum SaveType
HtmlComplete = 0
ArchiveSingleFile = 1
HtmlOnly = 2
TextOnly = 3
End Enum

Public Enum DownloadResult
NotInitialized = -1
Success = 0
Failure = 1
TimedOut = 2
FileAlreadyExists = 3
End Enum

Private Declare Function SetForegroundWindow Lib "user32" (Hwnd As Long) As Long

Private DownloadHelper As Worksheet
Private pSaveWebpageAsResult As DownloadResult
Private Const TempFileName As String = "4ou5yzBtFE8mp1RHj6hO.xls"

Friend Function SaveWebpageAs(Browser As Object, SaveAsFileName As String, _
SaveAsType As SaveType, Caller As Object, Optional OverWriteExistingFile As Boolean, _
Optional TimeOutInSeconds As Double = 10) As DownloadResult

If DownloadHelper Is Nothing Then Set DownloadHelper = GetChildRef
DownloadHelper.Parent.SaveWebpageAs SaveAsFileName, SaveAsType, Caller, OverWriteExistingFile, TimeOutInSeconds
Browser.ExecWB 4, 0
SaveWebpageAs = pSaveWebpageAsResult
AppActivate Application.Caption
End Function

Private Function GetChildRef() As Worksheet
Dim a As New Application
Dim TempFileFullName As String, o As OLEObject

TempFileFullName = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & TempFileName

If Not CreateObject("Scripting.FileSystemObject").FileExists(TempFileFullName) Then
Application.EnableEvents = False
Set o = Sheets("SaveFileAsUtility").OLEObjects(1)
o.Enabled = True
o_Object.SaveAs TempFileFullName
o_Object.Close
o.Enabled = False
Application.EnableEvents = True
End If

With a.Workbooks.Open(TempFileFullName)
Set GetChildRef = .Sheets(1)
End With

End Function

Friend Property Get SaveWebpageAsResult() As DownloadResult
If DownloadHelper Is Nothing Then
SaveWebpageAsResult = NotInitialized
Exit Property
Else
SaveWebpageAsResult = pSaveWebpageAsResult
End If
End Property

Public Sub UpdateSaveWebpageAsResult(Value As DownloadResult, WriteAccessCode As String)
If DownloadHelper Is Nothing Then Exit Sub
If Not DownloadHelper.Parent.ValidWriteAccessCode(WriteAccessCode) Then Exit Sub
pSaveWebpageAsResult = Value
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
DownloadHelper.Parent.Parent.Quit
End Sub
</textarea>

Download SaveFileAsUtility.zip and extract SaveFileAsUtility.xls to a location of your choice. Open SaveFileAsUtility.xls along side YourDownloader.xls. Copy or move the only worksheet located in SaveFileAsUtility.xls, sheet "SaveFileAsUtility", into YourDownloader.xls. This worksheet contains an oleobject which is actually a complete workbook. This workbook contains all of the code needed to automate the saveas dialog. See DownloadHelper.xls in the next post to view the code contained within this workbook. Save and close YourDownloader.xls. YourDownloader.xls should be ready to go.


Here is an example of how you might use this from your existing code. Note the Result values that the function will return to you...
<table width="100%" border="1" bgcolor="White" style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Sub</font> Example()
       <font color="#0000A0">Dim</font> ie <font color="#0000A0">As</font> Object, Result <font color="#0000A0">As</font> DownloadResult

       <font color="#0000A0">Set</font> ie = CreateObject("InternetExplorer.Application")
       ie.navigate "www.google.com"
       <font color="#0000A0">Do</font> <font color="#0000A0">Until</font> ie.readystate = 4 <font color="#0000A0">And</font> <font color="#0000A0">Not</font> ie.busy: DoEvents: <font color="#0000A0">Loop</font>

       Result = ThisWorkbook.SaveWebpageAs(ie, _
           ThisWorkbook.Path & "\Temp.mht", _
           ArchiveSingleFile, ThisWorkbook, True)

       <font color="#0000A0">Select</font> <font color="#0000A0">Case</font> Result <font color="#0000A0">Or</font> ThisWorkbook.SaveWebpageAsResult
           <font color="#0000A0">Case</font> NotInitialized: [a1] = "NotInitialized"
           <font color="#0000A0">Case</font> Success: [a1] = "Success"
           <font color="#0000A0">Case</font> Failure: [a1] = "Failure"
           <font color="#0000A0">Case</font> TimedOut: [a1] = "TimedOut"
           <font color="#0000A0">Case</font> FileAlreadyExists: [a1] = "FileAlreadyExists"
       <font color="#0000A0">End</font> <font color="#0000A0">Select</font>

       ie.Quit
       <font color="#0000A0">Set</font> ie = <font color="#0000A0">Nothing</font>

       CreateObject("WScript.Shell").Run """" & ThisWorkbook.Path & "\Temp.mht" & """"
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
</FONT></td></tr></table><button onclick='document.all("102220066217421").value=document.all("102220066217421").value.replace(/<br \/>\s\s/g,"");document.all("102220066217421").value=document.all("102220066217421").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("102220066217421").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="102220066217421" wrap="virtual">
Sub Example()
Dim ie As Object, Result As DownloadResult

Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "www.google.com"
Do Until ie.readystate = 4 And Not ie.busy: DoEvents: Loop

Result = ThisWorkbook.SaveWebpageAs(ie, _
ThisWorkbook.Path & "\Temp.mht", _
ArchiveSingleFile, ThisWorkbook, True)

Select Case Result Or ThisWorkbook.SaveWebpageAsResult
Case NotInitialized: [a1] = "NotInitialized"
Case Success: [a1] = "Success"
Case Failure: [a1] = "Failure"
Case TimedOut: [a1] = "TimedOut"
Case FileAlreadyExists: [a1] = "FileAlreadyExists"
End Select

ie.Quit
Set ie = Nothing

CreateObject("WScript.Shell").Run """" & ThisWorkbook.Path & "\Temp.mht" & """"
End Sub</textarea>

Here is a ready to go template with example usage code in sheet Example.

MyDownloader.zip
 
L

Legacy 98055

Guest

ADVERTISEMENT

In your workbook that will be performing the downloading, see the first code listing in the previous post.

DownloadHelper.xls
Create a blank workbook with one worksheet. Place this code into the workbook class:
<table width="100%" border="1" bgcolor="White" style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Option</font> <font color="#0000A0">Explicit</font>

  <font color="#0000A0">Public</font> <font color="#0000A0">Enum</font> SaveType
       HtmlComplete = 0
       ArchiveSingleFile = 1
       HtmlOnly = 2
       TextOnly = 3
  <font color="#0000A0">End</font> <font color="#0000A0">Enum</font>

  <font color="#0000A0">Private</font> pWriteAccessCode <font color="#0000A0">As</font> <font color="#0000A0">String</font>
  <font color="#0000A0">Private</font> pCaller <font color="#0000A0">As</font> <font color="#0000A0">Object</font>

  <font color="#0000A0">Public</font> <font color="#0000A0">Sub</font> SaveWebpageAs(SaveAsFileName <font color="#0000A0">As</font> String, _
      SaveAsType <font color="#0000A0">As</font> SaveType, Caller <font color="#0000A0">As</font> Object, <font color="#0000A0">Optional</font> OverWriteExistingFile, _
      <font color="#0000A0">Optional</font> TimeOutInSeconds <font color="#0000A0">As</font> <font color="#0000A0">Double</font> = 10)

       <font color="#0000A0">Dim</font> TimeOutTime <font color="#0000A0">As</font> Date, GetStringSaveAsType <font color="#0000A0">As</font> <font color="#0000A0">String</font>
       TimeOutTime = DateAdd("s", TimeOutInSeconds, Now)

       <font color="#0000A0">Select</font> <font color="#0000A0">Case</font> SaveAsType

           <font color="#0000A0">Case</font> HtmlComplete
               GetStringSaveAsType = "Webpage, complete (*.htm;*.html)"

           <font color="#0000A0">Case</font> ArchiveSingleFile
               GetStringSaveAsType = "Web Archive, single file (*.mht)"

           <font color="#0000A0">Case</font> HtmlOnly
               GetStringSaveAsType = "Webpage, HTML only (*.htm;*.html)"

           <font color="#0000A0">Case</font> TextOnly
               GetStringSaveAsType = "Text File (*.txt)"

       <font color="#0000A0">End</font> <font color="#0000A0">Select</font>

       <font color="#0000A0">Set</font> pCaller = Caller
       <font color="#0000A0">Call</font> BeginPolling(SaveAsFileName, GetStringSaveAsType, Caller, OverWriteExistingFile, TimeOutTime)

  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Friend</font> <font color="#0000A0">Function</font> Caller() <font color="#0000A0">As</font> <font color="#0000A0">Object</font>
       <font color="#0000A0">Set</font> Caller = pCaller
  <font color="#0000A0">End</font> <font color="#0000A0">Function</font>

  <font color="#0000A0">Public</font> <font color="#0000A0">Function</font> ValidWriteAccessCode(WriteAccessCode <font color="#0000A0">As</font> String) <font color="#0000A0">As</font> <font color="#0000A0">Boolean</font>
       ValidWriteAccessCode = (WriteAccessCode = pWriteAccessCode)
  <font color="#0000A0">End</font> <font color="#0000A0">Function</font>

  <font color="#0000A0">Friend</font> <font color="#0000A0">Property</font> <font color="#0000A0">Get</font> WriteAccessCode() <font color="#0000A0">As</font> <font color="#0000A0">String</font>
       WriteAccessCode = pWriteAccessCode
  <font color="#0000A0">End</font> <font color="#0000A0">Property</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> Workbook_Open()
       pWriteAccessCode = Me.Name & " " & CStr(CDbl(Now))
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> Workbook_BeforeClose(Cancel <font color="#0000A0">As</font> Boolean)
       <font color="#0000A0">Call</font> EndPolling
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
</FONT></td></tr></table><button onclick='document.all("1022200685538890").value=document.all("1022200685538890").value.replace(/<br \/>\s\s/g,"");document.all("1022200685538890").value=document.all("1022200685538890").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("1022200685538890").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="1022200685538890" wrap="virtual">
Option Explicit

Public Enum SaveType
HtmlComplete = 0
ArchiveSingleFile = 1
HtmlOnly = 2
TextOnly = 3
End Enum

Private pWriteAccessCode As String
Private pCaller As Object

Public Sub SaveWebpageAs(SaveAsFileName As String, _
SaveAsType As SaveType, Caller As Object, Optional OverWriteExistingFile, _
Optional TimeOutInSeconds As Double = 10)

Dim TimeOutTime As Date, GetStringSaveAsType As String
TimeOutTime = DateAdd("s", TimeOutInSeconds, Now)

Select Case SaveAsType

Case HtmlComplete
GetStringSaveAsType = "Webpage, complete (*.htm;*.html)"

Case ArchiveSingleFile
GetStringSaveAsType = "Web Archive, single file (*.mht)"

Case HtmlOnly
GetStringSaveAsType = "Webpage, HTML only (*.htm;*.html)"

Case TextOnly
GetStringSaveAsType = "Text File (*.txt)"

End Select

Set pCaller = Caller
Call BeginPolling(SaveAsFileName, GetStringSaveAsType, Caller, OverWriteExistingFile, TimeOutTime)

End Sub

Friend Function Caller() As Object
Set Caller = pCaller
End Function

Public Function ValidWriteAccessCode(WriteAccessCode As String) As Boolean
ValidWriteAccessCode = (WriteAccessCode = pWriteAccessCode)
End Function

Friend Property Get WriteAccessCode() As String
WriteAccessCode = pWriteAccessCode
End Property

Private Sub Workbook_Open()
pWriteAccessCode = Me.Name & " " & CStr(CDbl(Now))
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call EndPolling
End Sub</textarea>

Place this code into a standard module:
<table width="100%" border="1" bgcolor="White" style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Option</font> <font color="#0000A0">Explicit</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> SetTimer <font color="#0000A0">Lib</font> "user32" (ByVal Hwnd <font color="#0000A0">As</font> Long, <font color="#0000A0">ByVal</font> nIDEvent <font color="#0000A0">As</font> Long, <font color="#0000A0">ByVal</font> uElapse <font color="#0000A0">As</font> Long, <font color="#0000A0">ByVal</font> lpTimerFunc <font color="#0000A0">As</font> Long) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> KillTimer <font color="#0000A0">Lib</font> "user32" (ByVal Hwnd <font color="#0000A0">As</font> Long, <font color="#0000A0">ByVal</font> nIDEvent <font color="#0000A0">As</font> Long) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> FindWindowEx <font color="#0000A0">Lib</font> "user32" <font color="#0000A0">Alias</font> "FindWindowExA" (ByVal hWnd1 <font color="#0000A0">As</font> Long, <font color="#0000A0">ByVal</font> hWnd2 <font color="#0000A0">As</font> Long, <font color="#0000A0">ByVal</font> lpsz1 <font color="#0000A0">As</font> String, <font color="#0000A0">ByVal</font> lpsz2 <font color="#0000A0">As</font> String) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> FindWindow <font color="#0000A0">Lib</font> "user32" <font color="#0000A0">Alias</font> "FindWindowA" (ByVal lpClassName <font color="#0000A0">As</font> String, <font color="#0000A0">ByVal</font> lpWindowName <font color="#0000A0">As</font> String) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> SendMessage <font color="#0000A0">Lib</font> "user32" <font color="#0000A0">Alias</font> "SendMessageA" (ByVal Hwnd <font color="#0000A0">As</font> Long, <font color="#0000A0">ByVal</font> wMsg <font color="#0000A0">As</font> Long, <font color="#0000A0">ByVal</font> wParam <font color="#0000A0">As</font> Long, lParam <font color="#0000A0">As</font> Any) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Sub</font> Sleep <font color="#0000A0">Lib</font> "kernel32" (ByVal dwMilliseconds <font color="#0000A0">As</font> Long)

  <font color="#0000A0">Private</font> <font color="#0000A0">Const</font> WM_SETTEXT = &HC
  <font color="#0000A0">Private</font> <font color="#0000A0">Const</font> BM_CLICK = &HF5
  <font color="#0000A0">Private</font> <font color="#0000A0">Const</font> CB_SELECTSTRING <font color="#0000A0">As</font> <font color="#0000A0">Long</font> = &H14D
  <font color="#0000A0">Private</font> <font color="#0000A0">Const</font> WM_GETTEXT = &HD
  <font color="#0000A0">Private</font> <font color="#0000A0">Const</font> WM_GETTEXTLENGTH = &HE

  <font color="#0000A0">Private</font> pTimerID <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
  <font color="#0000A0">Private</font> pSaveAsFileName <font color="#0000A0">As</font> <font color="#0000A0">String</font>
  <font color="#0000A0">Private</font> pSaveAsType <font color="#0000A0">As</font> <font color="#0000A0">String</font>
  <font color="#0000A0">Private</font> pTimeOutTime <font color="#0000A0">As</font> <font color="#0000A0">Date</font>
  <font color="#0000A0">Private</font> pCaller <font color="#0000A0">As</font> <font color="#0000A0">Object</font>
  <font color="#0000A0">Private</font> pOverWriteExistingFile <font color="#0000A0">As</font> <font color="#0000A0">Boolean</font>
  <font color="#0000A0">Private</font> pCancelSave <font color="#0000A0">As</font> <font color="#0000A0">Boolean</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> Callback(ByVal Hwnd <font color="#0000A0">As</font> Long, _
       <font color="#0000A0">ByVal</font> uint1 <font color="#0000A0">As</font> Long, _
       <font color="#0000A0">ByVal</font> nEventId <font color="#0000A0">As</font> Long, _
       <font color="#0000A0">ByVal</font> dwParam <font color="#0000A0">As</font> Long)

       <font color="#0000A0">On</font> <font color="#0000A0">Error</font> <font color="#0000A0">Resume</font> <font color="#0000A0">Next</font>
       <font color="#0000A0">Dim</font> SaveAsDialogHwnd <font color="#0000A0">As</font> Long, FileNameEditBoxHwnd <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
       <font color="#0000A0">Dim</font> SaveAsTypeComboBoxHwnd <font color="#0000A0">As</font> Long, ButtonHwnd <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
       <font color="#0000A0">Dim</font> ComboBoxEx32_1 <font color="#0000A0">As</font> Long, ControlText <font color="#0000A0">As</font> String, FailureCnt <font color="#0000A0">As</font> <font color="#0000A0">Integer</font>

       SaveAsDialogHwnd = FindWindow("#32770", "Save Web Page")
       <font color="#0000A0">If</font> SaveAsDialogHwnd = 0 <font color="#0000A0">Then</font> SaveAsDialogHwnd = FindWindow("#32770", "Save Webpage")

       <font color="#0000A0">If</font> SaveAsDialogHwnd <> 0 <font color="#0000A0">Then</font>
           ComboBoxEx32_1 = FindWindowEx(SaveAsDialogHwnd, 0, "ComboBoxEx32", vbNullString)
           FileNameEditBoxHwnd = FindWindowEx(ComboBoxEx32_1, 0, "ComboBox", vbNullString)
           FileNameEditBoxHwnd = FindWindowEx(FileNameEditBoxHwnd, 0, "Edit", vbNullString)
           SendMessage FileNameEditBoxHwnd, WM_SETTEXT, 0, <font color="#0000A0">ByVal</font> pSaveAsFileName & vbNullChar
           Sleep 100
           SaveAsTypeComboBoxHwnd = FindWindowEx(SaveAsDialogHwnd, ComboBoxEx32_1, "ComboBox", vbNullString)
           SendMessage SaveAsTypeComboBoxHwnd, CB_SELECTSTRING, 0, <font color="#0000A0">ByVal</font> pSaveAsType
           Sleep 100

           <font color="#0000A0">If</font> <font color="#0000A0">Not</font> pCancelSave <font color="#0000A0">Then</font>
               ButtonHwnd = FindWindowEx(SaveAsDialogHwnd, 0, "Button", "&Save")
           <font color="#0000A0">Else</font>
               ButtonHwnd = FindWindowEx(SaveAsDialogHwnd, 0, "Button", "Cancel")
           <font color="#0000A0">End</font> <font color="#0000A0">If</font>

           <font color="#0000A0">If</font> InStr(GetControlText(FileNameEditBoxHwnd), pSaveAsFileName) <> 0 _
             <font color="#0000A0">And</font> InStr(GetControlText(SaveAsTypeComboBoxHwnd), pSaveAsType) <> 0 <font color="#0000A0">Then</font>

               <font color="#0000A0">Call</font> pCaller.UpdateSaveWebpageAsResult(IIf(pCancelSave, 3#, 0#), ThisWorkbook.WriteAccessCode)
               SendMessage ButtonHwnd, BM_CLICK, 0, 0
               EndPolling
               <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
           <font color="#0000A0">Else</font>
               FailureCnt = FailureCnt + 1
               <font color="#0000A0">If</font> FailureCnt > 50 <font color="#0000A0">Then</font>
                   <font color="#0000A0">Call</font> pCaller.UpdateSaveWebpageAsResult(1, ThisWorkbook.WriteAccessCode)
                   EndPolling
                   <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
               <font color="#0000A0">End</font> <font color="#0000A0">If</font>
           <font color="#0000A0">End</font> <font color="#0000A0">If</font>
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       <font color="#0000A0">If</font> Now >= pTimeOutTime <font color="#0000A0">Then</font>
           <font color="#0000A0">Call</font> pCaller.UpdateSaveWebpageAsResult(2, ThisWorkbook.WriteAccessCode)
           EndPolling
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Sub</font> BeginPolling(SaveAsFileName <font color="#0000A0">As</font> String, SaveAsType <font color="#0000A0">As</font> String, Caller <font color="#0000A0">As</font> Object, OverWriteExistingFile, TimeOutTime <font color="#0000A0">As</font> Date)
       pSaveAsFileName = SaveAsFileName
       pSaveAsType = SaveAsType
       <font color="#0000A0">Set</font> pCaller = Caller
       pTimeOutTime = TimeOutTime
       <font color="#0000A0">If</font> CreateObject("Scripting.FileSystemObject").FileExists(SaveAsFileName) <font color="#0000A0">Then</font>
           <font color="#0000A0">If</font> OverWriteExistingFile <font color="#0000A0">Then</font>
               Kill SaveAsFileName
           <font color="#0000A0">Else</font>
               pCancelSave = <font color="#0000A0">True</font>
           <font color="#0000A0">End</font> <font color="#0000A0">If</font>
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       pTimerID = SetTimer(0, 0, 250, <font color="#0000A0">AddressOf</font> Callback)
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Sub</font> EndPolling()
       <font color="#0000A0">Call</font> KillTimer(0, pTimerID)
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Function</font> GetControlText(Hwnd <font color="#0000A0">As</font> Long) <font color="#0000A0">As</font> <font color="#0000A0">String</font>
       <font color="#0000A0">Dim</font> TxtLen <font color="#0000A0">As</font> Integer, ControlText <font color="#0000A0">As</font> <font color="#0000A0">String</font>

       TxtLen = SendMessage(Hwnd, WM_GETTEXTLENGTH, <font color="#0000A0">ByVal</font> 0, <font color="#0000A0">ByVal</font> 0) + 1
       ControlText = Space(TxtLen - 1)
       SendMessage Hwnd, WM_GETTEXT, <font color="#0000A0">ByVal</font> TxtLen, <font color="#0000A0">ByVal</font> ControlText
       GetControlText = ControlText
  <font color="#0000A0">End</font> <font color="#0000A0">Function</font>
</FONT></td></tr></table><button onclick='document.all("1022200685612140").value=document.all("1022200685612140").value.replace(/<br \/>\s\s/g,"");document.all("1022200685612140").value=document.all("1022200685612140").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("1022200685612140").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="1022200685612140" wrap="virtual">
Option Explicit

Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Private 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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5
Private Const CB_SELECTSTRING As Long = &H14D
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Private pTimerID As Long
Private pSaveAsFileName As String
Private pSaveAsType As String
Private pTimeOutTime As Date
Private pCaller As Object
Private pOverWriteExistingFile As Boolean
Private pCancelSave As Boolean

Private Sub Callback(ByVal Hwnd As Long, _
ByVal uint1 As Long, _
ByVal nEventId As Long, _
ByVal dwParam As Long)

On Error Resume Next
Dim SaveAsDialogHwnd As Long, FileNameEditBoxHwnd As Long
Dim SaveAsTypeComboBoxHwnd As Long, ButtonHwnd As Long
Dim ComboBoxEx32_1 As Long, ControlText As String, FailureCnt As Integer

SaveAsDialogHwnd = FindWindow("#32770", "Save Web Page")
If SaveAsDialogHwnd = 0 Then SaveAsDialogHwnd = FindWindow("#32770", "Save Webpage")

If SaveAsDialogHwnd <> 0 Then
ComboBoxEx32_1 = FindWindowEx(SaveAsDialogHwnd, 0, "ComboBoxEx32", vbNullString)
FileNameEditBoxHwnd = FindWindowEx(ComboBoxEx32_1, 0, "ComboBox", vbNullString)
FileNameEditBoxHwnd = FindWindowEx(FileNameEditBoxHwnd, 0, "Edit", vbNullString)
SendMessage FileNameEditBoxHwnd, WM_SETTEXT, 0, ByVal pSaveAsFileName & vbNullChar
Sleep 100
SaveAsTypeComboBoxHwnd = FindWindowEx(SaveAsDialogHwnd, ComboBoxEx32_1, "ComboBox", vbNullString)
SendMessage SaveAsTypeComboBoxHwnd, CB_SELECTSTRING, 0, ByVal pSaveAsType
Sleep 100

If Not pCancelSave Then
ButtonHwnd = FindWindowEx(SaveAsDialogHwnd, 0, "Button", "&Save")
Else
ButtonHwnd = FindWindowEx(SaveAsDialogHwnd, 0, "Button", "Cancel")
End If

If InStr(GetControlText(FileNameEditBoxHwnd), pSaveAsFileName) <> 0 _
And InStr(GetControlText(SaveAsTypeComboBoxHwnd), pSaveAsType) <> 0 Then

Call pCaller.UpdateSaveWebpageAsResult(IIf(pCancelSave, 3#, 0#), ThisWorkbook.WriteAccessCode)
SendMessage ButtonHwnd, BM_CLICK, 0, 0
EndPolling
Exit Sub
Else
FailureCnt = FailureCnt + 1
If FailureCnt > 50 Then
Call pCaller.UpdateSaveWebpageAsResult(1, ThisWorkbook.WriteAccessCode)
EndPolling
Exit Sub
End If
End If
End If

If Now >= pTimeOutTime Then
Call pCaller.UpdateSaveWebpageAsResult(2, ThisWorkbook.WriteAccessCode)
EndPolling
End If

End Sub

Sub BeginPolling(SaveAsFileName As String, SaveAsType As String, Caller As Object, OverWriteExistingFile, TimeOutTime As Date)
pSaveAsFileName = SaveAsFileName
pSaveAsType = SaveAsType
Set pCaller = Caller
pTimeOutTime = TimeOutTime
If CreateObject("Scripting.FileSystemObject").FileExists(SaveAsFileName) Then
If OverWriteExistingFile Then
Kill SaveAsFileName
Else
pCancelSave = True
End If
End If

pTimerID = SetTimer(0, 0, 250, AddressOf Callback)
End Sub

Sub EndPolling()
Call KillTimer(0, pTimerID)
End Sub

Private Function GetControlText(Hwnd As Long) As String
Dim TxtLen As Integer, ControlText As String

TxtLen = SendMessage(Hwnd, WM_GETTEXTLENGTH, ByVal 0, ByVal 0) + 1
ControlText = Space(TxtLen - 1)
SendMessage Hwnd, WM_GETTEXT, ByVal TxtLen, ByVal ControlText
GetControlText = ControlText
End Function</textarea>

SaveAs DownloadHelper.xls and close.

From the workbook with the calling code which will be performing the automated saveas' from Internet Explorer, add a worksheet and name it "SaveFileAsUtility". From the worksheet menu bar, select Insert, Object, Create from File, Browse for "DownloadHelper.xls", Insert, Ok. Hide sheet "SaveFileAsUtility". Save and close the file.
 

jpsmith1

Board Regular
Joined
Aug 4, 2003
Messages
61
I found this thread after posting for help here: http://www.mrexcel.com/board2/viewtopic.php?p=1150952#1150952

Is there a cleaner way to use a URL to download a CSV file and then open it without using send keys? Specifically, I am trying to use a macro to download stock price data from the Yahoo web site for many stocks at once so that I can crunch numbers on what would be the best portfolio based on the given stocks.
 
L

Legacy 98055

Guest
Yes. Much better way. I will need some sample data that is represented by the variable you are using to build your url.

SendKeys "http://ichart.finance.yahoo.com/table.csv?s=" & Ticker & "&a=" & Fmonth & "&b=" & Fday & "&c=" & Fyear & "&d=" & Smonth & "&e=" & Sday & "&f=" & Syear & "&g=w&ignore=.csv"

Better to send me the workbook...

This thread is unrelated to what you are looking for. I'll post any replies on your previous thread.
 

Watch MrExcel Video

Forum statistics

Threads
1,111,910
Messages
5,541,541
Members
410,547
Latest member
htran4
Top