投稿‎ > ‎

リストファイル、サイズ、修正日時

posted Mar 12, 2019, 1:19 AM by Zhang Wenxu

' 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

Comments