用webbrowser打开一个网上的Excel文件，如何将其保存到本地？

Question

用webbrowser打开一个网上的Excel文件，如何将其保存到本地？
比如：
http://www.csdn.net/333.xls用代码实现Save As功能， 我用 WebBrowser.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER
可以实现把网页保存到本地，但是如果是excel文件就会出错run-time error
method 'ExecWB' of object 'Iwebbrowser2' failed请高人指点一下，谢谢了！！

Answer 1

Dim xlApp As New Excel.Application
    Dim xlBook As New Excel.Workbook
    Dim xlSheet As New Excel.Worksheet    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("E:\Excel\PrintPhoto.xls")
    Set xlSheet = xlBook.Worksheets(1)前提條件是文件PrintPhoto.xls要存在

Answer 2

不用webbrowser下载,判断后缀名用API的HTTP下载,如果需要发短消息,我把源码写上另外VBA是可以新建xls文件的

Answer 3

Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Boolean
'自动拨号程序
Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Boolean
'断开自动拨号
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAcessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
'返回连接句柄
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal lpszServerName As String, ByVal nServerPort As Integer, ByVal lpszUsername As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
'打开指定FTP,HTTP,GOPHER站点
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal lpszVerb As String, ByVal lpszObjectName As String, ByVal lpszVersion As String, byValReferer As String, ByVal lpszAcceptTypes As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
'根据一个HTTP句柄,打开一个HTTP请求
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal lpszheaders As String, ByVal dwHeadersLenght As Long, ByVal lpOptional As String, ByVal dwOptionalLength As Long) As Boolean
'向HTTP Server发送指定句柄
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal dwNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long) As Boolean
'Reads data from a handle opened by the InternetOpenUrl, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function.
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal address As String, ByVal headers As String, ByVal headlenght As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
'打开一个Internet URL地址
Dim url(400) As String
'URL地址数组
Dim levu(1000) As String
'
Dim xz As Integer
Dim oo As Integer
Dim bHTML As Boolean
'是否下载HTML
Dim bJpg As Boolean
'是否下载gif/jpeg
Dim bAll As Boolean
'是否下载所有类型
Dim o As Integer
Dim ooo As Integer
Dim levl(1000) As String
Dim strDurl As String
Dim exitproc As Boolean
Dim msize As Long
'log文件大小
Dim b As Boolean
Dim f As Boolean
Dim files As Integer
'文件个数
Dim hInternet As Long
Dim hConnect As Long
Dim strServer As String
Dim iPort As Integer
Dim bRes As Boolean
Dim lFlags As Long
Dim hRequest As Long
Dim strURL As String
Dim strBuffer As String * 1
Dim strDir As String
Dim strFile As String
Dim strMurl As String
Dim appdir As String
Dim files1 As Integer
Const INTERNET_FLAG_NO_COOKIES = &H80000
Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Const INTERNET_SERVICE_HTTP = 3Private Sub cmdBack_Click()
Load frmUrl
'装载frmUrl窗体
frmUrl.Text1.Text = txtWebsite.Text
frmUrl.Text2.Text = txtDir.Text
'数据保持一致
Unload Me
'卸载本窗体
frmUrl.Show
'显示frmUrl窗体
End SubPrivate Sub cmdStart_Click()
txtMessages.Text = ""On Error Resume Next
'忽略所有错误
cmdStart.Enabled = False
'开始按钮不再有效
exitproc = False
'这时不能再退出程序
Gif89a1.Visible = True
'显示动画
Gif89a1.FileName = App.Path & "\mov1.gif"
xz = 0
o = 1
oo = 1
ooo = 1
Dim a As Integer
Dim c As Integer
Dim er As Integer
Dim br As Integer
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim s As String
files1 = Text1.Text
If Check1.Value = 1 Then bHTML = True Else bHTML = False
'是否下载HTML
If Check2.Value = 1 Then bJpg = True Else bJpg = False
'是否下载gif/jpeg
If Check3.Value = 1 Then bAll = True Else bAll = False
'是否下载所有类型
appdir = txtDir.Text
'下载路径
br = Len(appdir)
'br:下载路径字符串的长度
er = InStrRev(appdir, "\")
'er:下载路径的最后一个"\"的位置
If Not fso.folderexists(appdir) Then
    MsgBox "Invalid destination directory"
    Exit Sub
End If
'如果路径不存在,退出
If br = er Then appdir = Left(appdir, br)
stryyy = txtWebsite.Text
'下载的站点地址
files = 0
'文件个数等于0
c = Len(stryyy)
a = InStr(stryyy, "/")
'a:站点地址的第一个"/"位置
If a = 0 Then stryyy = stryyy & "/"
'如果没有/的话,加一个
a = InStr(stryyy, "/")
'a:站点地址的第一个"/"位置
strServer = Left(stryyy, a - 1)
'服务器地址
strURL = Right(stryyy, c - a + 1)
'URL在站点上面的相对路径
strTryurl = strURL
er = InStr(strTryurl, ".htm")
If er = 0 Then er = InStr(strTryurl, ".asp")
'如果没有".htm",看看有没有".asp"
If er = 0 Then
    a = InStrRev(strTryurl, "/")
    If Not a = Len(strTryurl) Then strTryurl = strTryurl & "/"
    a = InStrRev(strTryurl, "/")
    c = Len(strTryurl)
    strMurl = Left(strTryurl, a - 1)
'最后获得的有效URL
    Call getsize
'调用getsize
    Call urltry
'调用urltry
Else
    a = InStrRev(strTryurl, "/")
    c = Len(strTryurl)
    strMurl = Left(strTryurl, a - 1)
End If
iPort = 80
Call process(strServer, strURL)
'调用执行
Call stripurl
'调用stripurl
txtMessages.Text = txtMessages.Text & vbCrLf & " Starting to download links in file"
txtMessages.SelStart = Len(txtMessages.Text)
'显示消息,开始下载
Call dotry
'开始下载
For jj = 1 To o
    Call level1(url(jj))
Next jj
Call downlevel
For jj = 1 To oo
    Call level2(levu(jj))
Next jj
Call downlevel2
MsgBox "Finished downloading"
'下载完毕
Command1.Caption = "Exit"
'清理内存
Set frmMain = Nothing
Set frmstart = Nothing
Set frmUrl = Nothing
cmdStart.Enabled = True
End Sub
Private Sub download(strSServer As String, strUURL As String)
On Error Resume Next
'忽略一切错误
If exitproc = True Then Exit Sub
'保护性退出
Dim sServer As String
'服务器
Dim sUrl As String
'地址
Dim x As String
Dim y As String
Dim z, f
If files > files1 Then Exit Sub
iPort = 80
sServer = strSServer
sUrl = strUURL
iFlags = INTERNET_FLAG_NO_COOKIES
iFlags = iFlags Or INTERNET_FLAG_NO_CACHE_WRITE
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.fileexists(appdir & sUrl) Then Exit Sub
hInternet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
'打开一个Internet句柄
If hInternet <> 0 Then txtMessages.Text = txtMessages.Text & vbCrLf & "Open Successfull"
hConnect = InternetConnect(hInternet, sServer, iPort, "", "", INTERNET_SERVICE_HTTP, 0, 0)
'连接
If hConnect <> 0 Then txtMessages.Text = txtMessages.Text & vbCrLf & "Connect Succesfull"
hRequest = HttpOpenRequest(hConnect, "GET", sUrl, "HTTP/1.0", vbNullString, vbNullString, iFlags, 0)
'打开请求
If hRequest <> 0 Then txtMessages.Text = txtMessages.Text & vbCrLf & "Http Open Request succesfull"
bRes = HttpSendRequest(hRequest, vbNullString, 0, vbNullString, 0)
'发送请求
If bRes = True Then txtMessages.Text = txtMessages.Text & vbCrLf & "Request successfull"
strDir = Dir(appdir & sUrl)
If Len(strDir) > 0 Then
Kill appdir & sUrl
End If
'如果已经存在则删除
iFile = FreeFile()
Call makedire(sUrl)
'建立目录
Open appdir & sUrl For Binary Access Write As iFile
'打开文件
Do
bRes = InternetReadFile(hRequest, strBuffer, Len(strBuffer), lBytesRead)
'打开网页
If lBytesRead > 0 Then
Put iFile, , strBuffer
End If
'写入文件
Loop While lBytesRead > 0
Close iFile
files = files + 1
txtMessages.Text = txtMessages.Text & vbCrLf & "Finished downloading " & sServer & sUrl
txtMessages.SelStart = Len(txtMessages.Text)
DoEvents
'下载完毕
If exitproc = True Then Unload Me
End Sub