' Mainサブルーチン
Sub Main ()
  Dim fn
    ' Excelアプリケーションのインスタンス生成
  Dim objXls : Set objXls = CreateObject("Excel.Application")
  Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

  If objXls Is Nothing Then Exit Sub

  ' Excelの表示
  objXls.Visible = True
  'objXls.ScreenUpdating = False
  objXls.ScreenUpdating = True

  ' Workbookを新規作成
  Set objWorkbook = objXls.Workbooks.Add()

  'objWorkbooks.sheets(1).cells(1,1).value = WScript.Arguments(0)
  'objWorkbook.Sheets(1).Cells(1,1).value = "Test"
  objWorkbook.Sheets(1).Cells(1,1).value = WScript.Arguments(0)
 
  ret = runCmd("dir /b /s """ & WScript.Arguments(0) & """")
  'objWorkbook.Sheets(1).Cells(2,1).value = ret
  lines = Split(ret, vbCrLf)
  Set cel = objWorkbook.Sheets(1).Cells(2, 2)
  For Each line In lines
   If line <> "" and  InStr(line, ".svn") <= 0 then
    cel.value = line
    If fso.FileExists(line) Then
     Set fn = fso.GetFile(line)
     cel.offset(0, 1).value = "'" & fn.DateLastModified
     cel.offset(0, 2).value = fn.Size
    End If
    set cel = cel.offset(1, 0)
    
   end if
  Next
  ' Workbookを保存
  'objWorkbook.SaveAs(GetCurrentDirectory() & "\test2.xlsx")
  'objWorkbook.SaveAs("C:\work" & "\test2.xlsx")

  ' Workbookを閉じる
  'objWorkbook.Close

  ' Excelの終了
  'objXls.ScreenUpdating = True
  'objXls.Quit

  ' インスタンスの破棄
  Set objXls = Nothing
End Sub

Function runCmd(strCmd)
    Dim fso

    Dim tempFile

    Dim wsh

    Dim waitOnReturn

    Dim windowStyle
    Dim oFile
   
    set fso = CreateObject("Scripting.FileSystemObject")
    set wsh = CreateObject("WScript.Shell")
   
    tempFile = fso.GetSpecialFolder(TemporaryFolder) & "\" & Replace(fso.GetTempName(), ".tmp", ".txt")

    strCmd = "cmd /c " & strCmd & " > " & tempFile & " 2>&1"

    waitOnReturn = True

    windowStyle = 0

    wsh.Run strCmd, windowStyle, waitOnReturn

    On Error Resume Next

    'runCmd = fso.OpenTextFile(tempFile, ForReading, False).ReadAll
    Set oFile = fso.GetFile(tempFile)

    'If IsNull(oFile) Then MsgBox ("File not found: " & strPath): Exit Function
    If IsNull(oFile) Then
        runCmd = "File not found: " & tempFile
        Exit Function
    End If
   
    With oFile.OpenAsTextStream()
        runCmd = .Read(oFile.Size)
        .Close
    End With

End Function

' Mainサブルーチンの実行
Main

Option Explicit

Public Sub readXML()
    Dim cel As Range
    Dim filename As String
    Dim elements  As MSXML2.IXMLDOMNodeList

    Dim element As MSXML2.IXMLDOMNode
    Dim contents As String
   
    Dim sh As Worksheet
    Dim rowData As Long
    Dim xmlDoc As New MSXML2.DOMDocument60
    Dim fso As New FileSystemObject
   
    rowData = 1
   
    Set cel = ActiveCell
    filename = Cells(1, 1).Value & cel.Value
   
    If Not fso.FileExists(filename) Then
        Debug.Assert False
    End If
   
    contents = readFileBinary(filename)
   
    'contents = Replace(contents, "encoding='UTF-8'", "")
    Call xmlDoc.LoadXML(contents)
    If Not xmlDoc.parseError Is Nothing Then
        Debug.Print xmlDoc.parseError.reason
        Debug.Print xmlDoc.parseError.line
    End If
    Set sh = Worksheets.Add

    Call iterateNode(xmlDoc.DocumentElement, sh, 1)
    Set xmlDoc = Nothing
End Sub

Public Sub iterateNode(node As MSXML2.IXMLDOMNode, sh As Worksheet, row As Integer)
    Dim childNode As MSXML2.IXMLDOMNode
    Dim length As Integer
    Dim index As Integer
   
    If node.ChildNodes.length = 0 Then
        Exit Sub
    End If
   
    If node.BaseName = "jdbc-system-resource" Then
        row = row + 1
    End If
   
    If node.ParentNode.BaseName = "jdbc-system-resource" Then
        If Application.WorksheetFunction.CountIf(sh.Rows(1), node.BaseName) > 0 Then
            index = Application.WorksheetFunction.Match(node.BaseName, sh.Rows(1), False)
        Else
            index = Application.WorksheetFunction.CountA(sh.Rows(1))
            sh.Cells(1, index + 1).Value = node.BaseName
            index = index + 1
        End If
       
        sh.Cells(row, index).Value = node.text
    End If
   
    For length = 0 To node.ChildNodes.length - 1
        Set childNode = node.ChildNodes(length)
        Call iterateNode(childNode, sh, row)
    Next
End Sub

'MSXML2.DOMDocument60

Sub mark()
'
' mark Macro
'

Public Sub getFileEncode2()
    Dim cmd As String
    Dim ret As String
    Dim cel As Range
    Dim filename As String
    Dim fileContent As String
   
    For Each cel In Selection
        If cel.EntireRow.Hidden Then GoTo NEXT_ROW
        ret = ""
        filename = "C:\source" & cel.Value
        cmd = """""C:\tools\nkf.exe"""" -g " & filename
       
        ret = runCmd(cmd)
       
        Cells(cel.row, "M").Value = Replace(Replace(Replace(Replace(ret, Chr(10), ""), Chr(13), ""), "-", ""), "ASCII", "SJIS")
       
        If "BINARY" <> Cells(cel.row, "M").Value Then
            fileContent = readFileBinary(filename)
            If InStr(fileContent, Chr(13) & Chr(10)) > 0 Then
                Cells.Cells(cel.row, "N").Value = "CRLF"
            Else
                Cells.Cells(cel.row, "N").Value = "LF"
            End If
        Else
            Cells.Cells(cel.row, "N").Value = "-"
        End If
       
NEXT_ROW:
    Next
End Sub

Public Function runCmd(strCmd As String) As String
    Dim fso As New FileSystemObject

    Dim tempFile As String

    Dim wsh As New WshShell

    Dim waitOnReturn As Boolean

    Dim windowStyle As Integer
    Dim oFile As Variant
   
    tempFile = fso.GetSpecialFolder(TemporaryFolder) & "\" & Replace(fso.GetTempName(), ".tmp", ".txt")

    strCmd = "cmd /c " & strCmd & " > " & tempFile & " 2>&1"

    waitOnReturn = True

    windowStyle = 0

    wsh.Run strCmd, windowStyle, waitOnReturn

    On Error Resume Next

    'runCmd = fso.OpenTextFile(tempFile, ForReading, False).ReadAll
    Set oFile = fso.GetFile(tempFile)

    'If IsNull(oFile) Then MsgBox ("File not found: " & strPath): Exit Function
    If IsNull(oFile) Then
        runCmd = "File not found: " & tempFile
        Exit Function
    End If
   
    With oFile.OpenAsTextStream()
        runCmd = .Read(oFile.Size)
        .Close
    End With

End Function

Public Function readFileBinary(filename As String) As String
    Dim fso As New FileSystemObject
    Dim oFile As Variant
    If Not fso.FileExists(filename) Then
        readFileBinary = ""
        Exit Function
    End If
   
    Set oFile = fso.GetFile(filename)

    'If IsNull(oFile) Then MsgBox ("File not found: " & strPath): Exit Function
    If IsNull(oFile) Then
        readFileBinary = "File not found: " & filename
        Exit Function
    End If
   
    With oFile.OpenAsTextStream()
        readFileBinary = .Read(oFile.Size)
        .Close
    End With
End Function