将爬取的数据不要写入EXCEL,直接输出到文本,格式按EXCEL内置的格式
如题,有个VBA爬取网页数据的代码,因为不会数组,不知道如何改这个代码,我的要求是不想它写入EXCEL直接输出到文本中,要求尽可能的快最好,请高手或管理出手帮改一下,谢谢!程序代码:
Sub All_3() Dim objXML As Object Dim i, j, k Dim ar_data Dim myStr, sp Set objXML = CreateObject("MSXML2.ServerXMLHTTP") Sheet6.Range("A2:L1048576").ClearContents myStr = "http://64.push2.,m:0+t:13,m:0+t:80,m:1+t:2,m:1+t:23&fields=f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f12,f13,f14,f15,f16,f17,f18,f20,f21,f23,f24,f25,f22,f11,f62,f128,f136,f115,f152&_=1603443145439" With objXML .Open "GET", myStr, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .setRequestHeader "Cache-Control", "no-cache" .setRequestHeader "If-Modified-Since", "0" .send sp = .responseText End With sp = Split(sp, "f1" & Chr(34) & ":") ReDim ar_data(1 To UBound(sp), 1 To 12) For i = 1 To UBound(sp) ar_data(i, 1) = Replace(Replace(Split(Split(sp(i), "f12")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 2) = Replace(Replace(Split(Split(sp(i), "f14")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 3) = Replace(Replace(Split(Split(sp(i), "f2")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 4) = Replace(Replace(Split(Split(sp(i), "f15")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 5) = Replace(Replace(Split(Split(sp(i), "f16")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 6) = Replace(Replace(Split(Split(sp(i), "f17")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 7) = Replace(Replace(Split(Split(sp(i), "f18")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 8) = Replace(Replace(Split(Split(sp(i), "f4")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 9) = Replace(Replace(Split(Split(sp(i), "f3")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 10) = Replace(Replace(Split(Split(sp(i), "f8")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 11) = Replace(Replace(Split(Split(sp(i), "f5")(1), ",")(0), Chr(34), ""), ":", "") ar_data(i, 12) = Replace(Replace(Split(Split(sp(i), "f6")(1), ",")(0), Chr(34), ""), ":", "") Next Sheet6.Range("A2").Resize(UBound(ar_data), UBound(ar_data, 2)) = ar_data ar_data = Sheet6.Range("A1").CurrentRegion For j = 1 To UBound(ar_data) i_row = "" ar_data(j, 1) = Format(ar_data(j, 1), "000000") For k = 1 To UBound(ar_data, 2) i_row = i_row & vbTab & ar_data(j, k) Next i_col = i_col & vbNewLine & i_row Next Open ThisWorkbook.Path & "outfile.txt" For Output As #1 Print #1, i_col Close #1 MsgBox "OK" End Sub
[local]1[/local]