excel-vba-操作相关对象引用

1，使用Adodb.Stream对象提取字符串

Function BytesToBstr(strBody, CodeBase)         '使用Adodb.Stream对象提取字符串
    Dim objStream
    On Error Resume Next
    Set objStream = CreateObject("Adodb.Stream")
    With objStream
        .Type = 1                               '二进制
        .Mode = 3                               '读写
        .Open
        .write strBody                          '二进制数组写入Adodb.Stream对象内部
        .Position = 0                           '位置起始为0
        .Type = 2                               '字符串
        .Charset = CodeBase                     '数据的编码格式
        BytesToBstr = .ReadText                 '得到字符串
    End With
    objStream.Close
    Set objStream = Nothing
    If Err.Number <> 0 Then BytesToBstr = ""
    On Error GoTo 0
End Function

2，使用正则表达式匹配responsetext中 sessionID=数字 的内容

Sub reg_sessionID()
    Set reg = CreateObject("VBSCRIPT.REGEXP")
    With reg
        .Global = True
        .IgnoreCase = True
        .Pattern = "&sessionID=\d{1,}"
    End With
   Set mc = reg.Execute(responsetext)
   sessionID = Split(mc(0).Value, "=")(1)
   '对象引用完成后需要置空
   Set reg = Nothing
   Set mc = Nothing
End Sub

3，使用adodb链接数据库

Sub ReturnSQLrecord()
    'sht 为excel工作表对象变量,指向某一工作表
    Dim i&, sht As Worksheet
    
    '定义数据链接对象 ，保存连接数据库信息
    '使用ADODB，须在菜单的Tools->References中添加引用“Microsoft ActiveX Data Objects library 2.x”
   ' Dim cn As New ADODB.Connection
    
    '定义记录集对象，保存数据表
    'Dim rs As New ADODB.Recordset
    Dim strCn As String, strSQL As String
    
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("Adodb.Recordset")
    '定义数据库链接字符串,Server=服务器名称或IP地址(本地可填写“.”);Database=数据库名称;Uid=用户登录名;Pwd=密码
    strCn = "Provider=sqloledb;Server=.;Database=train1;Uid=sa;Pwd=123;"
    
    '定义SQL查询命令字符串
    strSQL = "select name,user from dbo.[test] "
    
    '与数据库建立连接，如果成功，返回连接对象cn
    cn.Open strCn
    
    '执行strSQL所含的SQL命令，结果保存在rs记录集对象中
    rs.Open strSQL, cn
    
    i = 1
    '把sht指向当前工作簿的sheet1工作表
    Set sht = ThisWorkbook.Worksheets("数据查询区")
    sht.Range("A1").CopyFromRecordset rs
    
    '当数据指针未移到记录集末尾时，循环下列操作
'    Do While Not rs.EOF
'
'        '把当前记录的job_id字段的值保存到sheet1工作表的第i行第1列
'        sht.Cells(i, 1) = rs("name")
'        sht.Cells(i, 2) = rs("user")
'
'        '把指针移向下一条记录
'        rs.MoveNext
'        i = i + 1
'    Loop
    
    '关闭记录集
    rs.Close
    
    '关闭数据库链接,释放资源
    cn.Close
End Sub

4，创建一个html对象，将responsetxt 中的数据复制到单元格’

Sub HTML取数()
        Set oDoc = CreateObject("htmlfile")
        oDoc.body.innerHTML = responsetext
'                Set MyData = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
'                With MyData                'DataObject对象，数据放入剪贴板，记事本观察数据
'                    .setText responsetext
'                    .PutInClipboard
'                End With
        On Error Resume Next
        ThisWorkbook.Sheets(3).UsedRange.NumberFormatLocal = "G/通用格式"
        If pn = 1 Then
            ThisWorkbook.Sheets(3).UsedRange.Delete xlUp             'clearcontents
        Else
        End If
        cou = oDoc.all.tags("table").Length
        With ThisWorkbook.Sheets(3)
            Set r = oDoc.all.tags("table")(0).Rows
            lastrow = .Range("A65536").End(3).Row
            For i = 0 To r.Length - 1
                For j = 0 To r(i).Cells.Length - 1
                       .Cells(i + 1 + lastrow, j + 1) = r(i).Cells(j).innerText
                Next
            Next
        End With
End Sub

5，json格式单词解析

Sub figjson3()
    aa = "{""myname"":""Michael"",""myaddress"":{""city"":""Beijing"",""street"":"" Chaoyang Road "",""postcode"":100025}}"
    Set X = CreateObject("ScriptControl")
    X.Language = "JScript"
    s = "function j(s) { return eval('(' + s + ')'); }"
    X.AddCode s
    Set y = X.Run("j", aa)
      
   MsgBox y.myname
   MsgBox y.myaddress
   MsgBox y.myaddress.city
   MsgBox y.myaddress.postcode
End Sub

6，将列表中的元素一次性写入单元格

Sub JsonToRng()    
    'JSON 直写 Range
    Dim sJson$, js$
    sJson = [ "{'sn':'篮球','kz':'birinxi','cp':'baishi'} , {'sn':'报龄','kz':'kazet','py':'baoling'} , {'sn':'编简','kz':'taryh','py':'bianjian'} , {'sn':'白兆灯','kz':'tokا','py':'biannianshi'} , {'sn':'杠铃','kz':'dop','py':'bieshi'}]"  
    js = "var r,k,row=c=1,d={};for(r in j){row++;for(k in j[r]){if(!d[k]){d[k]=c++;rng(1,d[k])=k;}rng(row,d[k])= j[r][k];}}"
    js = "j=" & sJson & ";" & js
    With CreateObject("ScriptControl")
        .Language = "JScript"
        .AddObject "rng", Cells(3, "A")  ' A3 是起始单元格，可以改为别的单元格
        .eval (js)
    End With
End Sub