VBA以POST方式上传数据-AngelHis
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


VBA以POST方式上传数据

发表时间:2022/1/19 17:25:20 评论(0) 浏览(4970)  评论 | 加入收藏 | 复制
   
摘 要:VBA以POST方式上传数据。
正 文:
'=========================
'VBA以POST方式上传数据、
'--------------------------
'strUrl            网址
'strData           内容
'strHeader         头文件
'strValue          头文件格式
'===========================
Function f_uploadDataPost(intState As Integer, _
                          strUrl As String, _
                          Optional strData As String, _
                          Optional li_tdiff As Integer, _
                          Optional strHeader As String, _
                          Optional strValue As String) As String
    On Error GoTo err
    Dim http As Object
    Dim I As Long
    Dim lt_stime As Date, lt_ntime As Date
    DoCmd.Hourglass True
    Set http = CreateObject("Microsoft.XMLHTTP")
    http.Open "POST", strUrl, False    '同步抓取
    If strHeader = "" Then strHeader = "CONTENT-TYPE"
    If strValue = "" Then strValue = "application/x-www-form-urlencoded"
    '    Debug.Print strData
    http.setRequestHeader strHeader, strValue     '头文件
    http.Send (strData)  '
    If li_tdiff = 0 Then li_tdiff = 10    '10秒
    lt_stime = Now()    '获取当前时间
    While http.ReadyState <> 4
        DoEvents
        lt_ntime = Now    '获取循环时间
        If DateDiff("s", lt_stime, lt_ntime) > li_tdiff Then    '服务器没有反应
            DoCmd.Hourglass False
            MsgBox "本机与【" & strUrl & "】通讯失败,服务器没有反应!", vbExclamation, "系统提示:" & http.Status
            Set http = Nothing
            Exit Function    '判断超出li_tdiff秒即超时退出过程
        End If
    Wend
    DoCmd.Hourglass False
    I = http.Status
    If I = 200 Then        '定义字符串 json
        f_uploadDataPost = http.responseText
        If InStr(f_uploadDataPost, "Error_Code") > 0 Then
            MsgBox f_uploadDataPost, , "系统提示"
            f_uploadDataPost = ""
        Else
            Debug.Print "交易地址:" & strUrl & vbNewLine & vbNewLine & _
                        "输入json:" & strData & vbNewLine & vbNewLine & _
                        "输出json:" & f_uploadDataPost
        End If
    Else
        intState = 100
        MsgBox "本机与Json服务器通讯失败:" & Chr(13) & "Url【" & strUrl & "】" & Chr(13) & _
               err.Description, vbExclamation, "系统提示 [f_uploadDataPost]" & "_" & http.Status
        f_uploadDataPost = ""
    End If
    Set http = Nothing
    Exit Function
err:
    DoCmd.Hourglass False
    intState = 100
    MsgBox "与【" & strUrl & "】通讯失败:" & Chr(13) & _
           Replace(Nz(err.Description, ""), "The system cannot locate the resource specified", "系统找不到指定的资源"), vbCritical, _
           "系统提示 [f_uploadDataPost]" & intState
    Set http = Nothing
End Function

Access软件网交流QQ群(群号:198465573)
 
 相关文章
【access源码】在数据库中实现文件上传下载  【红尘如烟  2010/4/20】
【access源码示例】上传图片或附件到指定文件夹或共享文件夹的通...  【金宇  2012/6/1】
【access源码示例】同一个产品上传多个图片示例  【金宇  2012/7/2】
VBA http post 上传 multipart/form-d...  【dbaseIIIer  2012/12/15】
平台上传附件功能,利用条件格式判断有没有附件  【宏鹏  2017/1/14】
【Access示例】选择excel文件并上传  【缪炜  2018/3/4】
Access开发平台--上传下载函数,实现通用附件支持FTP。  【丘苏洲  2019/4/17】
Access制作的附件上传下载改进示例  【茼蒿  2020/1/22】
常见问答
技术分类
相关资源
文章搜索
关于作者

AngelHis

文章分类

文章存档

友情链接