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><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
rogid: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.