Automating IE using VBA

cm2adams · Oct 18, 2006

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

Legacy 98055 · Oct 18, 2006

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 · Oct 19, 2006

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.

Legacy 98055 · Oct 22, 2006

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

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> 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

bject.SaveAs TempFileFullName

bject.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

</td></tr></table><button onclick='document.all("102220069948218").value=document.all("102220069948218").value.replace(/ \s\s/g,"");document.all("102220069948218").value=document.all("102220069948218").value.replace(/ /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

bject.SaveAs TempFileFullName

bject.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

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> 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
</td></tr></table><button onclick='document.all("102220066217421").value=document.all("102220066217421").value.replace(/ \s\s/g,"");document.all("102220066217421").value=document.all("102220066217421").value.replace(/ /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

Legacy 98055 · Oct 22, 2006

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

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> 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
</td></tr></table><button onclick='document.all("1022200685538890").value=document.all("1022200685538890").value.replace(/ \s\s/g,"");document.all("1022200685538890").value=document.all("1022200685538890").value.replace(/ /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

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> 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
</td></tr></table><button onclick='document.all("1022200685612140").value=document.all("1022200685612140").value.replace(/ \s\s/g,"");document.all("1022200685612140").value=document.all("1022200685612140").value.replace(/ /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 · Oct 25, 2006

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.

Legacy 98055 · Oct 25, 2006

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.

Automating IE using VBA

cm2adams

New Member

Excel Facts

Legacy 98055

Guest

cm2adams

New Member

Legacy 98055

Guest

Legacy 98055

Guest

jpsmith1

Board Regular

Legacy 98055

Guest

Similar threads

Forum statistics

Share this page

Automating IE using VBA

cm2adams

New Member

Excel Facts

Legacy 98055

Guest

cm2adams

New Member

Legacy 98055

Guest

Legacy 98055

Guest

jpsmith1

Board Regular

Legacy 98055

Guest

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock