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