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