如何正确设置岗位参数,接收指定日期的持股信息?

铊;

我正试图回答 this 所以问。它没有给出有效的答案,现在已经7个月大了。

我的问题是为什么我对同一个问题的解决方案不起作用。如果这被认为是重复的,我会删除它,并可能在另一个问题上提供奖励-但是我能指定我想要的答案来告诉我如何正确使用我提到的工具吗( fiddler );并使用 POST 请求? _{*假设我的方法确实可以成功部署。}

脚本:

场景相同,即删除此页: HKEXnews 并获取持股日期的历史数据 22/08/2017 ;写入此数据,包含在表中 持股情况 ,由其HTML ID标识 pnlResult ,或 table 标记索引 ("table")(2) 要超越。

与原始操作一样,我的方法返回的数据来自最新日期,而不是请求的日期。

如何正确地制定post请求以获取指定日期的数据? 也就是说,我是错过了小提琴手提供的信息,还是误解了提供的信息?

我尝试的解决方案:

我决定去那个网站,选择有问题的日期,用 fiddler .

我注意到在做了日期选择之后我可以看到 柱 提出了要求。

–所以我检查了标题:

我检查了网络表单的详细信息:

我用这些来制定一个对主机的post请求。

利息日的主要参数定义为 SHARE_DAY , SHARE_MONTH 和 SHARE_YEAR .

·Todo-我确实重构了 HTMLTable 把纸分成它自己的小部分;最初有 GetShareholdingInfo 作为函数返回 Object (相对于 可编程的 )我一直在 Error 70 Permission Denied 在传递htmltable对象时,最后我不得不使用下面的不太理想的解决方案。

注: 我看了问题向导提供的侧栏建议和其他一些问题。例如:

1. How can I send an HTTP POST request to a server from Excel using VBA?
2. Adding Parameters to VBA HTTP Post Request
3. Fetching data from a website using “POST” request

VBA:

Option Explicit

Public Sub ShareHoldingInfo()
    Dim headers(), ws As Worksheet
    Const SHARE_DAY As Long = 22
    Const SHARE_MONTH As Long = 8
    Const SHARE_YEAR As Long = 2017

    headers = Array("Stock Code", "Stock Name", "Shareholding in CCASS", "% of the total number of A shares listed and traded on the SSE")
    Application.ScreenUpdating = False

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With ws
        .Cells.ClearContents
        .Cells(1, 1) = "Shareholding Date: " & Format$(DateSerial(SHARE_YEAR, SHARE_MONTH, SHARE_DAY), "dd/mm/yyyy")
        .Cells(2, 1).Resize(1, UBound(headers) + 1) = headers
    End With

    GetShareholdingInfo SHARE_DAY, SHARE_MONTH, SHARE_YEAR, ws

    Application.ScreenUpdating = True
End Sub

Public Sub GetShareholdingInfo(ByVal ShareholdingDay As Long, ByVal ShareholdingMonth As Long, ByVal ShareholdingYear As Long, ByRef ws As Worksheet)
    Dim objHTTP As Object, URL As String, html As New HTMLDocument
    Const POST_PREFIX As String = "_VIEWSTATE=||1||& __VIEWSTATEGENERATOR=||2||& __EVENTVALIDATION=||3||"
    Dim vs As String, vsg As String, ev As String, sToday As String, sortBy As String, alertMsg As String, btnX As String, btnY As String

    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    URL = "http://www.hkexnews.hk/sdw/search/mutualmarket.aspx?t=hk%2f%3f"
    vs = "fQ3xjD+zA7WVka368FepJS4Hd3mTPU6XV2UPah+ERqFw2JopZen8Fh01/HNQ4fGDqq3Kvtf41T7rhMZswpllY27gJmmhH0FuboK69Mg7JbV2BrXq1R2YBHvSdgObosBV9jd1A5znZcEojA932bsVacdM0vXv87P8u6+G3yFMfYFXSFXESwmNvhyToVTFGvVXT2ZSfw=="
    vsg = "3C67932C"
    ev = "JHSF2ZFqsNlguCM2lnvh6Lm/Uw90fVvqToCx9tvqNX6rnXHd/f/kjekxc1L1IFsrCxIiOAgVSm0NkQOyVJ9xpg1KepfuKu+14YtRmjrRUtiHOcOptGnDqLGa1aqboGSjFoW/mUjh//B/yA9nPjzZYKHjNlMhHphc4Zb97hOuoVRuchFSnduT5eDI91mMmh7ad8oc+mB1HDyGdREDArhhSX6ZFGRB+IWwbJpT5YN5XQOKpSZNoS0sYjWTALysDOE/"
    ev = ev & "8fYSW1ggiXIQ0ZHSRqvq9xVJgshfk79svlBsNsHsrsIXf3XV12o8JdUiabpfy64I8bDkJo0IYgWKOP+03BGaRm93TwaXg+XmHJ9zDVg58JYIKmwI/tibYGK2hN+CS3E7CEineQptTXy+eFXjJVekVlhy8utVytRZD5BJQOWwVd+j7HYgra9JI7wL/8+mMCEJEzMjEDeHgnrbSpE48gvO7r7dWka4yDlRFtFZqnrYCmubIjP4ZlwUCAjY3Mx7gD22k2bXEg+uyTLnIJ3/"
    ev = ev & "5bkzEKgaKDMo7sbTeO1nku969aHNlTge9cIzaVuq7m5Tm8z4p0GhxOX6FRsy9ItCkg0k6zzNOFNKg7Rprd7xLs00AOxwxJd6Z17cLskUxOEWecivAh923t6thB9UPKtcGt2KxVqlAgqro3Ij7OGO+QGOM4ZGc5lnpI6TVyEipuM03OwpqmgKbKd2NpxfgMriujZYqLNwzjgAIxOPhzdfUDF6+c2kttHZ+zHFt+PDucS9cgJ7ijqszmYHWUeZ6qg3n8HbXEf+WszThZp70plUWOtWH8UvBVQ3y9CcI9aK4lmz/"
    ev = ev & "6W7yVx5sQUPBktX7GppJMViZRgOZnYU/x6Bpx9qEv/Pp0dQ0tq2jesl7UESS4YG2QMzmIbJBkRucW1+gxMXppG+Q1oL2kE2cEzDvYtF7sr6wdLzGtLpUcuDK4Jw9dZBimmI+o8QUMWOml1ccuwe686+ea8QJbi1RPKgpN3creNXhDW5w74xrZvXP/avY+XpGPg"
    ev = ev & "opjmUZ9qnZoVChvEDupCP5IfbKkeL2n+wYyupt45orDwbIxyg0GunTenMrI9CwoRN8w6X7SdFMG2IwojrOLnuuJt6ml/Tva5zHqflPfRPAAhn/jS5t+sf0jzBy2ZPMd5rlm7oDCRnD5X+4AnmjA0NhQrhW4s="
    sToday = Format$(Now, "yyyymmdd")
    sortBy = vbNullString
    alertMsg = vbNullString
    btnX = "29"
    btnY = "15"

    Dim sBody As String
    sBody = POST_PREFIX
    sBody = Replace$(Replace$(Replace$(POST_PREFIX, "||1||", vs), "||2||", vsg), "||3||", ev)
    sBody = sBody & "&today=" & sToday
    sBody = sBody & "&sortBy=" & sortBy
    sBody = sBody & "&alertMsg=" & alertMsg
    sBody = sBody & "&ddlShareholdingDay=" & ShareholdingDay
    sBody = sBody & "&ddlShareholdingMonth=" & ShareholdingMonth
    sBody = sBody & "&ddlShareholdingYear=" & ShareholdingYear
    sBody = sBody & "&btnSearch.x=" & btnX
    sBody = sBody & "&btnSearch.y=" & btnY

    With objHTTP
        .SetTimeouts 10000, 10000, 10000, 10000
        .Open "POST", URL, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        On Error Resume Next
        .send (sBody)
        If Err.Number = 0 Then
            If .Status = "200" Then
                html.body.innerHTML = .responseText
            Else
                Debug.Print "HTTP " & .Status & " " & .statusText
                Exit Sub
            End If
        Else
            Debug.Print "Error " & Err.Number & " " & Err.Source & " " & Err.Description
            Exit Sub
        End If
        On Error GoTo 0
    End With

    Dim hTable As Object
    'Set hTable = html.getElementsByTagName("table")(2)
    Set hTable = html.getElementById("pnlResult")
    Dim tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long
    r = 3
    With ws
        Set tRow = hTable.getElementsByTagName("tr") 'HTMLTableRow
        For Each tr In tRow
            Set tCell = tr.getElementsByTagName("td")
            c = 1
            For Each td In tCell                 'DispHTMLElementCollection
                .Cells(r, c).Value = td.innerText 'HTMLTableCell
                c = c + 1
            Next td
            r = r + 1
        Next tr
    End With
End Sub

当日网站样本:

我预期指定日期的结果:

从代码中写出的示例:

我得到了最新可用时间段的结果,即正常的登录页结果。

编辑:

感谢@jeped的评论。登录页上有以下信息(并非我在上面显示的所有信息)。

<form name="form1" method="post" action="./mutualmarket.aspx?t=hk%2f%3f" id="form1" style="text-align: left;">
	<div>
		<input type="hidden" name="__VIEWSTATE" id="__VIEWSTATE" value="bKL6Py6JoD+UqJiQ0rYby89kuE5F9cbnJNFYPp2spoXRpiUHWXMPRG8zwk8PILbZSbn81reaeg6k3H5YU/r2NPcdO0WwyXcyC7YqTiDi3xpXEPWm654UtThRL5HgsHmMZGRMMxBPiHUTA+GtplZ6t/s8chsO/dfnCHXzOQWQ6CazRo80IBYnDTrKY/6q9hx/YDRu+g==">
		</div>
		<div>
			<input type="hidden" name="__VIEWSTATEGENERATOR" id="__VIEWSTATEGENERATOR" value="3C67932C">
				<input type="hidden" name="__EVENTVALIDATION" id="__EVENTVALIDATION" value="HI5FxZFHKh1Q5D5ExYCAkTbgozWeAb/DOPLTwntzLbpFZaOqvYTa/jniEDrvg53syrn/3EpGt7IYjns+KXq6FaUppQRtjT2EosDG5wmuGEaf+WuKFRqUtRpcS2MGWJMEqbwTfiRyy7CLqcD1TqRBn/oey+UZyHCE/P2GpkQiYpVIZEABJdeW3ehj57EP+yDZcuWgAUtnjHjnkNk54+jTlD5r7S+lT8FGYm1uoytV7detJ5KL9XUI/By3iKETPSunsOzb8+zBMOYheIk1/7QiDDoAHOUcmelTLz6YmCM4j+xZD00nvVjMnLCERoUV/A32fidSnzaZEBk+Mgi8nVTZ+71u95p/D/ELwN/xeUen3cEy/cgYlyHi3MjLof3SSxOOWQUflufPA+kAnTT0XgoOguN/UO3QBfcvWAqgpWTPSujx6FLdSu7r9bk7DyBDD+uwqB5jKQkk+zqEoR1ODZ+Zp8VNqezsmPNczSBihHri207Hd++oHVKGlpbRG2KUBK0ngNjSQ2Gqqeuq4lOOCEl41JzBlHYZBIUSHp5tI2L61aR2gGFjVkPxyE8doM2EZZgdIUl9lDiWmTvtNU7nS12QC9v4e4whz1NSqC1LUOA/JVWiJ0KYdXG4AGyArcosOGZQF6eaFzkWw9ooak2LXPYbUb1pt+S+NfXk3vDpalfC+bthIukOas/QC8+RXQF5oiSZyNo3Znj+/jj1IvDwl7kJHR76k2XFeIb5Z+mTzBJMphze5S/VzkHN3E1vaFKQErQj5Y62wYssyfUKamCj21FhH6Era6IEiBxnUIinCIY/6387sBNlrdUabBfxK0Vm3gEjrGU/i5hSTmcn+t5/XBC6T8Xx5cVGIZUKDMtmFqkFF4RZtRpsuKfT1VyW0gDK26YrYW14bx19Tgm+8u2HmvvM7ZzbC1pabCJnlN6RhYswtm8aT7aq9TqcmV9wPfewHr5LOZaAsCjE+qTF+vrU1v2tmI4p7IevlhnomZO4BRD8bAogJF6LCWNUmxdTu5ewP4MJrOiP7cMDmuLHoiExdWL1PQOFh/E16JXw6liJuhk38+dG5eKzwt3bdeX3iT44XzHReE6pUK4G4nQIipa5LQFvXpsrCQ4lsn+BiXUdHtjhSG6S3kyYipOQrLEcSjYsHxZdUZDz4KmrhcEEcTVKXT4xxCFiQ74=">
				</div>
				<input type="hidden" name="today" id="today" value="20180623">
					<input type="hidden" name="sortBy" id="sortBy">
						<input type="hidden" name="alertMsg" id="alertMsg">

这部分反映了我在《小提琴手》中观察到的情况。