通过使用VBA代码自动单击和下载CSV文件,在Sheet中打开CSV文件

时间:2017-06-10 16:21:54

标签: excel vba excel-vba csv

几小时的搜索以及未在此处发布适当的帖子。最后,我找到了一个更好,更清晰的问题。

问题很简单,就像我在标题中提到的那样。我正在使用这个网站for downloading sample CSV file。要下载文件,我需要点击所需的文件,它将以.CSV格式下载到我的系统。

我找到并使用此代码自动执行该过程并使用VBA代码在工作簿中打开该文件。我在VBA编辑器中添加了所有引用,但是我无法弄清楚导致错误发生91对象变量或未设置块变量的原因

我已将IE的可见性设置为True,以检查它是否能够导航到该网站,并从我尝试使用以下名称下载文件的网站" AssetsImportCompleteSample。 CSV "

以下是代码:

Option Explicit

Sub foo()
'add some references via Tools/References:
'Microsoft ActiveX Data Objects 6.1 Library
'Microsoft XML, v6.0
'Microsoft Internet Controls
'Microsoft HTML Object Library
'Just add these and leave the defaulted ones alone

'This assumes the workbook is saved already, and that you want the file in the same folder and named "yyyymmdd hhmmss.csv"
On Error GoTo exitsub

Dim fileStream As ADODB.Stream 'the stream to download the file over
Dim xmlHTTP As MSXML2.xmlHTTP60 'out connection to the http output
Dim strURL As String
Dim strFile As String
Dim ie As InternetExplorer, ieDoc As HTMLDocument 'ie objects to get the url for the file

'first the page to navigate to. This sets up a current session ID which we can then query for the corresponding file
strURL = "https://www.ibm.com/support/knowledgecenter/en/SVU13_7.2.1/com.ibm.ismsaas.doc/import/r_sample_csv_files.html"

Set ie = New InternetExplorer
ie.Visible = True
ie.Navigate strURL

'best to wait until ie has finished getting the page
Do
    DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE

'get the document
Set ieDoc = ie.Document

'the download button is called "downloadData", getElementById returns the url we need.
strFile = ieDoc.getElementById("AssetsImportCompleteSample.csv")

'now get the file using ADODB
Set xmlHTTP = New MSXML2.xmlHTTP60
xmlHTTP.Open "GET", strFile
xmlHTTP.send

If xmlHTTP.Status <> 200 Then
    MsgBox "File not found"
    GoTo exitsub
End If

'now write the responseBody to a file as a csv, using an ADODB stream
Set fileStream = New ADODB.Stream
With fileStream
    .Open
    .Type = adTypeBinary
    .Write xmlHTTP.responseBody
    .Position = 0
    .SaveToFile ThisWorkbook.Path & "\" & Format(Now(), "yyyymmdd hhmmss") & ".csv"
    .Close
End With

'done
exitsub: 'very cursory error trapping in this, you should probably look after that.
If Err Then
    MsgBox "Error occurred " & vbCrLf & vbCrLf & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly
End If
'Tidy up
ie.Quit
Set ieDoc = Nothing
Set ie = Nothing
Set fileStream = Nothing
Set xmlHTTP = Nothing
End Sub

我无法弄清楚导致此错误,我可以看到所有设置变量都已正确关闭,但我确实需要社区的帮助才能使用它。

非常感谢帮助。 谢谢!

0 个答案:

没有答案