注册 登录
编程论坛 → VFP论坛

金山文档的vba代码请帮助转为vfp的，谢谢

ls_y041 发布于 4 小时前， 26 次点击
Sub query()
    Dim i&, r&, n&, k&
    Dim postData$, proCode$, proName$, firstClass$, secondClass$
    Dim arr()
    Dim oDom As Object, oWindow As Object, http As Object
    Set oDom = CreateObject("htmlfile")
    Set oWindow = oDom.parentWindow
    Set http = CreateObject("Msxml2.XMLHTTP")
    r = [A65536].End(xlUp).Row
    If r > 2 Then Range("A2:H" & r).ClearContents
    proCode = [J5]: proName = [J6]: firstClass = [J3]: secondClass = [J4]
    postData = "{" & Chr(34) & "Context" & Chr(34) & ":{" & Chr(34) & "argv" & Chr(34) & ":{" & Chr(34) & "proCode" & Chr(34) & ":" & Chr(34) & proCode & Chr(34) & "," & Chr(34) & "proName" & Chr(34) & ":" & Chr(34) & proName & Chr(34) & "," & Chr(34) & "firstClass" & Chr(34) & ":" & Chr(34) & firstClass & Chr(34) & "," & Chr(34) & "secondClass" & Chr(34) & ":" & Chr(34) & secondClass & Chr(34) & "}}}"
    http.Open "POST", "https://www., False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "AirScript-Token", "2jhQZq9WdAtvCUVFlxm8wl"
    http.send (postData)
    strHtml = http.responseText
    oWindow.execScript "js=" & strHtml
    n = oWindow.eval("js.data.result.length")
    If n = 0 Then
        MsgBox "没有可下载的数据"
        Exit Sub
    End If
    ReDim arr(0 To n - 1, 0 To 6)
    For i = 0 To n - 1
        For k = 0 To 6
            arr(i, k) = oWindow.eval("js.data.result[" & i & "][" & k & "]")
        Next
    Next
    [A3].Resize(n, 7) = arr
    MsgBox "完成"
End Sub
2 回复
#2
ls_y0413 小时前
Sub queryAll()
    Dim http As Object, strHtml$, n&, i&, k&, arr()
    Dim filePath As String
    Dim fileNumber As Integer
   
    ' 创建HTTP对象
    Set http = CreateObject("Msxml2.XMLHTTP")
   
    ' 发送HTTP请求
    http.Open "POST", "https://www., False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "AirScript-Token", "2jhQZq9WdAtvCUVFlxm8wl"
   
    ' 构造请求体（根据API文档调整）
    Dim postData$
    postData = "{""Context"":{""argv"":{""proCode"":"""",""proName"":"""",""firstClass"":"""",""secondClass"":""""}}}"
    http.send postData
   
    ' 检查HTTP状态
    If http.Status <> 200 Then
        MsgBox "HTTP请求失败，状态码：" & http.Status & vbCrLf & "响应内容：" & http.responseText
        Exit Sub
    End If
   
    ' 获取响应数据
    strHtml = http.responseText
   
    ' 将响应数据写入文本文件
    filePath = ThisWorkbook.Path & "\response.txt" ' 文件保存路径
    fileNumber = FreeFile
    Open filePath For Output As #fileNumber
    Print #fileNumber, strHtml
    Close #fileNumber
   
    MsgBox "响应数据已保存到：" & filePath
End Sub
#3
iswith2 小时前
LOCAL i, r, n, k
LOCAL postData, proCode, proName, firstClass, secondClass
LOCAL arr, strHtml, oDom, oWindow, http

* 初始化变量
proCode = ALLTRIM([J5])
proName = ALLTRIM([J6])
firstClass = ALLTRIM([J3])
secondClass = ALLTRIM([J4])

* 构建 POST 数据
postData = '{"Context":{"argv":{"proCode":"' + proCode + '","proName":"' + proName + '","firstClass":"' + firstClass + '","secondClass":"' + secondClass + '"}}}'

* 创建 HTTP 对象
http = CREATEOBJECT("WinHttp.WinHttpRequest.5.1")

* 发送 HTTP 请求
http.Open("POST", "https://www., .F.)
http.SetRequestHeader("Content-Type", "application/json")
http.SetRequestHeader("AirScript-Token", "2jhQZq9WdAtvCUVFlxm8wl")
http.Send(postData)

* 获取响应内容
strHtml = http.ResponseText

* 解析 JSON 数据
oDom = CREATEOBJECT("ScriptControl")
oDom.Language = "JScript"
oDom.AddCode("var js = " + strHtml + ";")

n = oDom.Eval("js.data.result.length")

IF n = 0 THEN
    MESSAGEBOX("没有可下载的数据")
    RETURN
ENDIF

* 创建数组并填充数据
DIMENSION arr(n, 7)
FOR i = 0 TO n - 1
    FOR k = 0 TO 6
        arr(i + 1, k + 1) = oDom.Eval("js.data.result[" + TRANSFORM(i) + "][" + TRANSFORM(k) + "]")
    ENDFOR
ENDFOR

* 将数据写入 Excel (假设 Excel 对象已经创建)
* 这里假设你已经有一个 Excel 对象，并且已经打开了工作表
* 例如：oExcel = CREATEOBJECT("Excel.Application")
* oSheet = oExcel.ActiveSheet

* 将数组写入 Excel
FOR i = 1 TO n
    FOR k = 1 TO 7
        oSheet.Cells(i + 2, k).Value = arr(i, k)
    ENDFOR
ENDFOR

MESSAGEBOX("完成")
1
©2025, BCCN.NET
电脑版