| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 35 人关注过本帖
标题:金山文档的vba代码请帮助转为vfp的,谢谢
只看楼主 加入收藏
ls_y041
Rank: 2
等 级:论坛游民
威 望:2
帖 子:178
专家分:66
注 册:2005-9-29
结帖率:95.24%
收藏
 问题点数:20 回复次数:2 
金山文档的vba代码请帮助转为vfp的,谢谢
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
搜索更多相关主题的帖子: Object If End Dim http 
6 小时前
ls_y041
Rank: 2
等 级:论坛游民
威 望:2
帖 子:178
专家分:66
注 册:2005-9-29
收藏
得分:0 
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
5 小时前
iswith
Rank: 7Rank: 7Rank: 7
等 级:黑侠
威 望:5
帖 子:512
专家分:651
注 册:2013-5-14
收藏
得分:0 
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("完成")
4 小时前
快速回复:金山文档的vba代码请帮助转为vfp的,谢谢
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.017374 second(s), 9 queries.
Copyright©2004-2025, BCCN.NET, All Rights Reserved