Board logo

标题: [文本处理] 【已解决】网页文本如何用批处理提取问题 [打印本页]

作者: tbjx138    时间: 2015-4-20 07:43     标题: 【已解决】网页文本如何用批处理提取问题

我有很多网页文件htm,想提取里面的文本内容,想实现批量提取,附件里有一个htm文件,还有需要的效果图,请大神们帮忙,先谢谢大神了!
作者: apang    时间: 2015-4-20 11:41

本帖最后由 apang 于 2015-4-20 13:46 编辑

vbs
  1. arr = Array("ssNumber", "bookName", "author", "pageNum", "publish", "isbn")
  2. Set fso = CreateObject("Scripting.FileSystemObject")
  3. For Each f in fso.GetFolder(".").Files
  4.         If LCase(Right(f, 4)) = ".htm" Then
  5.                 Name = fso.GetBaseName(f) & ".csv"
  6.                 fso.OpenTextFile(Name, 2, true).Write getData(f, arr)
  7.         End If
  8. Next
  9. MsgBox "OK"
  10. Function getData(file, ByVal arr)
  11.         s = Join(arr, ",") & vbCrLf
  12.         with CreateObject("ADODB.Stream")
  13.                 .Mode = 3
  14.                 .Type = 2
  15.                 .Open
  16.                 .CharSet = "utf-8"
  17.                 .LoadFromFile file
  18.                 txt = .ReadText
  19.         End with
  20.         Set re = New RegExp
  21.         re.Pattern = "\{[\s\S]+?}"
  22.         re.Global = true
  23.         re.IgnoreCase = true
  24.         For Each m in re.Execute(txt)
  25.                 ReDim a(UBound(arr))
  26.                 For i = 0 to UBound(arr)
  27.                         re.Pattern = """" & arr(i) & """:("".+?"")"
  28.                         If re.Test(m) Then a(i) = re.Execute(m)(0).SubMatches(0)
  29.                 Next
  30.                 s = s & Join(a, ",") & vbCrLf
  31.         Next
  32.         getData = s
  33. End Function
复制代码

作者: tbjx138    时间: 2015-4-20 12:51

vbs
apang 发表于 2015-4-20 11:41

感谢大神的回复,第680页可以提取,完全符合要求,我有很多这样的文件,麻烦大神能不能做个批量的代码,再次感谢大神的帮忙!!
作者: apang    时间: 2015-4-20 13:46

回复 3# tbjx138


    已修改
作者: tbjx138    时间: 2015-4-20 14:04

回复 4# apang

感谢大神,按照您给的代码问题已解决了!!谢谢大神的再次修改代码!!
作者: pcl_test    时间: 2015-4-20 14:20

问题得到解决后请在标题最前面注明[已解决]
http://www.bathome.net/thread-3473-1-1.html
作者: yu2n    时间: 2015-4-20 16:11

本帖最后由 yu2n 于 2015-4-20 22:47 编辑
vbs
apang 发表于 2015-4-20 11:41


我也重复造个轮子。XD
  1. '提取JSON文本.vbs   by yu2n 20150420
  2. Main
  3. Sub Main()
  4.   Dim arrName, SaveFile, fso, f
  5.   arrName = Array("ssnumber", "bookName", "author", "pageNum", "publish", "isbn")                 'JSON名称
  6.   SaveFile = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
  7.   SaveFile = SaveFile & Left(WScript.ScriptName, InStrRev(WScript.ScriptName, ".")-1) & ".csv"    '结果保存位置
  8.   ' 遍历同目录所有 *.htm 文档
  9.   Set fso = CreateObject("Scripting.FileSystemObject")
  10.   fso.OpenTextFile(SaveFile, 2, True, -1).Write Join(arrName, ",") & vbCrLf         '重置TXT,写入JSON名称
  11.   For Each f in fso.GetFolder(".").Files
  12.     If LCase(Right(f, 4)) = ".htm" Then
  13.       fso.OpenTextFile(SaveFile, 8, True, -1).Write getData(f, arrName) & vbCrLf    '追加写入TXT
  14.     End If
  15.   Next
  16.   MsgBox "OK"
  17. End Sub
  18. Function getData(file, arrName)
  19.   Dim strJson
  20.   strJson = ReadPfile(file, "UTF-8")  '以UTF-8编码读取JSON文文本
  21.   getData = GetJsonString(strJson, arrName)          '获取JSON值
  22. End Function
  23. '按编码读取txt文件内容
  24. Function ReadPfile(ByVal File, ByVal Charset)
  25. With CreateObject("ADODB.Stream")
  26.   .Type = 2
  27.   .Mode = 3
  28.   .open
  29.   .Charset = Charset
  30.   .LoadFromFile File
  31.   ReadPfile = .ReadText
  32.   .Close
  33. End With
  34. End Function
  35. '获取JSON字符串中的数据 by yu2n 20150420
  36. 'GetJson("{ ""myname"":""liucqa"", ""myid"":""007"" }", Array("myid")) = "007"
  37. Function GetJsonString(strJson, arrName)
  38.   On Error Resume Next
  39.   Dim oHTML, oWindow
  40.   Set oHTML = CreateObject("htmlfile")
  41.   Set oWindow = oHTML.parentWindow
  42.   oWindow.ExecScript "var arr=[], s;" & _
  43.     "var json=" & strJson & ";" & _
  44.     "var arrName=['" & Join(arrName, "','") & "'];" & _
  45.     "if(json instanceof Array){" & _
  46.     "  for(var i=0;i<json.length;i++){" & _
  47.     "    var arrTemp=[];" & _
  48.     "    for(var j=0;j<arrName.length;j++){" & _
  49.     "      arrTemp.push('""' + eval('(json[' + i + '].' + arrName[j] + ')' ) + '""')" & _
  50.     "    }" & _
  51.     "    arr.push(arrTemp.join(','));" & _
  52.     "  };" & _
  53.     "  s=arr.join('\r\n');" & _
  54.     "}else{" & _
  55.     "  for(var j=0;j<arrName.length;j++){" & _
  56.     "    arr.push('""' + eval('(json.' + arrName[j] +')') + '""')" & _
  57.     "  }" & _
  58.     "  s=arr.join(',');" & _
  59.     "}"
  60.   GetJsonString = oWindow.s
  61. End Function
复制代码

作者: tbjx138    时间: 2015-4-20 20:20

回复 7# yu2n
感谢大神的回复,测试您的代码,csv文件里没有分列,这是我的测试结果,最好在您修改后把这些文件提取后都放在一个csv文件里,就更好了!!
作者: yu2n    时间: 2015-4-20 22:53

回复 8# tbjx138

用 Notepad++ 可正常打开。因为漏掉了回车符号,系统自带的记事本打开时会出现不换行显示的情况。

代码更新到 7 楼:
1. 修正换行问题
2. 修改结果保存位置,多个 *.htm 处理结果保存到脚本同名的 *.csv 文件(Unicode编码)中。
作者: tbjx138    时间: 2015-4-21 07:10

回复 7# yu2n
感谢大神再次改写代码,提取文件都保存在一个csv里了,用excel打开,用里面的分列设置一下就成功分列了,效果不错!!谢谢大神的帮忙!!




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2