Public Sub listFiles(cel As Range) Dim link As Object Dim ie As InternetExplorer Dim iconName As String Dim fso As New FileSystemObject Dim I As Integer Dim name As String Dim td AsObject Application.ScreenUpdate = False Set ie = getProcenter() Call waitIE(ie) For Each link In ie.document.frames("main").document.links DoEvents If link.getEmentsByTagName("IMG").Length > 0 Then iconName = fso.getFilename(link.getElementsByTagName("IMG")(0).src) If link.innerText = "ファイル登録” Then GoTo NEXT_LINK End If If iconName = "file_node.gif" Then name = Trim(link.innerText) cel.Offset(0, 1).value = name cel.Offset(0, 2).NumberFormatLocal = "@" cel.Offset(0, 2).value = getQueryString(link.href, "Nid") 'File name Set td = link.parentElement For i = 1 To 7 Set td = td.nextSibling Next cel.Offset(0, 3).value = td.innerText 'Update time Set td = link.parentElement For i = 1 To 4 Set td = td.nextSibling Next cel.Offset(0, 4).NumberFormatLocal = "@" cel.Offset(0, 4).value = td.innerText 'Class name Set td = link.parentElement For i = 1 To 9 Set td = td.nextSibling Next cel.Offset(0, 5).value = td.innerText 'Seq Set td = link.parentElement For i = 1 To 2 Set td = td.nextSibling Next cel.Offset(0, 6).value = td.innerText cel.Parent.Cells(cel.row, "A").value = getDevNetPath(ie) & "/" & name Set cel = cel.Offset(1, 0) If Application.WorksheetFunction.CountA(Rows(cel.row)) > 0 Then cel.EntireRow.Insert Set cel = cel.Offset(-1, 0) End If End If End If NEXT_LINK: Next Application.ScreenUpdating = True End Sub Public Function getQueryString(href As String, key As String) As String Dim qs As Variant Dim q As Variant Dim keyValue As Variant qs = Split(href, "&") For Each q In qs DoEvents keyValue = Split(q, "=") If keyValue(0) = key Then getQueryString = keyValue(1) Exit For End If Next End Function |
投稿 >