[已解决]谢谢HYY514老师，网络数据提取有误

lhj323323

老师：
那天，我高兴昏头了，虽然实现了从网络提取数据，但没有发现提取的数据与我想实现的效果的差距。



如果确实无法按我希望的格式导出数据，只要能将涉及的数据导出，我再想办法解决格式问题也可。

最佳答案

月排行榜 / 总排行榜

HYY514

2011-3-19 12:32

http://www.szse.cn/main/disclosure/news/scgkxx/index.shtml 导出:


Sub fff()
Dim st      As Date
Dim sp      As Date
Dim i       As Date
Dim shtm    As String
Dim sDate   As String
Dim sMsg    As String
st = "2011-02-11"
sp = "2011-03-11"
With CreateObject("MICROSOFT.XMLHTTP")
    For i = st To sp
        sDate = Format(i, "yymmdd")
        .Open "get", "http://www.szse.cn/szseWeb/common/szse/files/text/jy/jy" & sDate & ".txt", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send ""
        shtm = StrConv(.responseBody, vbUnicode)
        If InStr(shtm, "深圳证券市场") Then
          toTXT shtm, i
           'toSheet shtm, i
        Else
           sMsg = sMsg & i & vbCrLf
        End If
    Next
End With
If Len(sMsg) Then MsgBox sMsg & "无记录!"
Shell "explorer.exe " & ThisWorkbook.Path, vbNormalNoFocus
End Sub
Sub toTXT(s As String, ByVal sN As String)
    Open ThisWorkbook.Path & "\" & sN & ".txt" For Output As #1
        Print #1, s
    Close #1
End Sub
Sub toSheet(s As String, ByVal sN As String)
Dim cl As New DataObject
With cl
.Clear
.SetText s
.PutInClipboard
End With
Sheets.Add(, Sheets(Sheets.Count)).name = sN
ActiveSheet.Paste
End Sub

跳转到最佳答案楼层

HYY514

我不是业内人士，看不懂你的要求

吕?布

跟着学习

lhj323323

回复 HYY514 的帖子

HH514老师：
我也不是业内人士，我只是想把你找到的那个网页的后面部分的数据导出来，在那个网页http://www.szse.cn/main/disclosure/news/scgkxx/index.shtml中，您不是导出了“证券列表”中的内容吗，我还想把“证券列表”的下面的“详细信息”的内容也导出来。仅此而已。

还有，我没有强行要求一定要按模板中的工作表[我希望达到的效果]中的数据格式导出，而是只要能将那些数据导出，不拘泥于我想要的数据格式。

lhj323323

回复 lhj323323 的帖子

求助

吕?布

实际上他已经把整个网页内容读取出来了,你根据情况分列应该就能得出你要的数据了

HYY514

http://www.szse.cn/main/disclosure/news/scgkxx/index.shtml 导出:


Sub fff()
Dim st      As Date
Dim sp      As Date
Dim i       As Date
Dim shtm    As String
Dim sDate   As String
Dim sMsg    As String
st = "2011-02-11"
sp = "2011-03-11"
With CreateObject("MICROSOFT.XMLHTTP")
    For i = st To sp
        sDate = Format(i, "yymmdd")
        .Open "get", "http://www.szse.cn/szseWeb/common/szse/files/text/jy/jy" & sDate & ".txt", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send ""
        shtm = StrConv(.responseBody, vbUnicode)
        If InStr(shtm, "深圳证券市场") Then
          toTXT shtm, i
           'toSheet shtm, i
        Else
           sMsg = sMsg & i & vbCrLf
        End If
    Next
End With
If Len(sMsg) Then MsgBox sMsg & "无记录!"
Shell "explorer.exe " & ThisWorkbook.Path, vbNormalNoFocus
End Sub
Sub toTXT(s As String, ByVal sN As String)
    Open ThisWorkbook.Path & "\" & sN & ".txt" For Output As #1
        Print #1, s
    Close #1
End Sub
Sub toSheet(s As String, ByVal sN As String)
Dim cl As New DataObject
With cl
.Clear
.SetText s
.PutInClipboard
End With
Sheets.Add(, Sheets(Sheets.Count)).name = sN
ActiveSheet.Paste
End Sub

lhj323323

回复 吕?布 的帖子

吕布老师：
我不懂如何根据情况进行分列。

lhj323323

回复 HYY514 的帖子

HYY514老师：
程序能将数据以txt格式导入到与模板同处一个文件夹内，
我现在打算将这些txt文件导入到指定文件夹内，并试着修改您写的第二个程序：
Sub toTXT(s As String, ByVal sN As String)
'HYY514老师_将数据导入到模板所处的文件夹内
    Open ThisWorkbook.Path & "\" & sN & ".txt" For Output As #1
'我修改_将数据导入到指定文件夹内
'电脑报错：“运行时错误55，文件已打开”
    newpath = "d:\我的文档\GP\深圳数据"
    Open newpath & "\" & sN & ".txt" For Output As #1
        Print #1, s
    Close #1
End Sub

这是什么原因呢？还有，如果直接把这些数据导入到模板内的工作表sheet2中，如何修改呢？

lhj323323

吕?布 发表于 2011-3-19 09:03
实际上他已经把整个网页内容读取出来了,你根据情况分列应该就能得出你要的数据了

吕布老师：
你是指那天那个贴子：

http://www.excelpx.com/forum.php?mod=viewthread&tid=154462&page=2#pid2525470
的第13楼HYY514老师写的两个程序中的第二个程序

Sub PrintRng(ByVal shtm As String, ByVal lpa As Integer)
Dim arr() As String
Dim artmp() As String
Dim i As Integer
arr = Split(shtm, "width='65' align='center' >")
Cells(lr, 1) = "第" & lpa & "页"
For i = 1 To UBound(arr)
' Debug.Print arr(i)
lr = lr + 1
artmp = Split(arr(i), "</td>")
Cells(lr, 1) = artmp(0)
artmp = Split(arr(i), "align='center' >")
Cells(lr, 2) = "'" & Split(artmp(1), "</td>")(0)
Cells(lr, 3) = Split(artmp(2), "</td>")(0)
artmp = Split(arr(i), "align='right' >")
Cells(lr, 4) = Split(artmp(1), "</td>")(0)
Cells(lr, 5) = Split(artmp(2), "</td>")(0)
artmp = Split(arr(i), "align='left' >")
Cells(lr, 6) = Split(artmp(1), "</td>")(0)
Next
lr = lr + 1
End Sub

在这里进行修改“分列”吗？