- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
本帖最後由 stillfish00 於 2016-11-9 17:20 編輯
回復 2# wwwlen2002
只處理cms_value_####.xml
XML_PATH 自行改為正確路徑
參考 :- Sub Test()
- Dim t: t = Timer
-
- Const XML_PATH = "C:\Users\xxxxx\Downloads\CMS\CMS\20150101"
- Dim oXml As Object: Set oXml = CreateObject("msxml2.domdocument")
- Dim sFile As String, sTime As String, sCmsid As String, sMessage As String
- Dim oNodes As Object, arData, cnt As Long
- ReDim arData(1 To 3, 1 To 1)
- sFile = Dir(XML_PATH & "\")
- Do While Len(sFile) > 0
- If sFile Like "cms_value_####.xml" Then
- oXml.Load XML_PATH & "\" & sFile
- With oXml.ChildNodes(1)
- sTime = .getAttribute("updatetime")
- Set oNodes = .getElementsbyTagName("Info")
- ReDim Preserve arData(1 To 3, 1 To UBound(arData, 2) + oNodes.Length)
- For Each x In oNodes
- sMessage = WorksheetFunction.Asc(x.getAttribute("message")) '全形轉半形
- If HasMyKeyWords(sMessage) Then
- sCmsid = x.getAttribute("cmsid")
- cnt = cnt + 1
- arData(1, cnt) = sTime
- arData(2, cnt) = sCmsid
- arData(3, cnt) = sMessage
- End If
- Next
- ReDim Preserve arData(1 To 3, 1 To cnt)
- End With
- End If
- sFile = Dir()
- Loop
-
- If cnt > 0 Then
- With Sheets.Add(After:=Sheets(Sheets.Count))
- .[a1].Resize(1, 3) = Array("updatetime", "cmsid", "message")
- .[a2].Resize(cnt, 3) = Application.Transpose(arData)
- .UsedRange.Columns.AutoFit
- End With
- End If
-
- MsgBox "執行時間 " & Timer - t & " 秒", vbOKOnly
- End Sub
- Function HasMyKeyWords(s As String) As Boolean
- For Each x In Array("壅塞", "K", "k", "雨", "天候不佳")
- If InStr(1, s, x) > 0 Then
- HasMyKeyWords = True
- Exit Function
- End If
- Next
- HasMyKeyWords = False
- End Function
|
|
發表於 2016-11-9 17:17
| 