URL

　URL

　URL

たまたま手元にあるノートパソコンのサイズを計ってみました

　　　　　外横　外奥　中横　中縦　中斜
ノート[A] 30.5　25.0　28.5　21.5　35.5
ノート[B] 27.5　24.0　24.5　18.5　30.5
ノート[C] 26.0　20.0　21.0　15.5　26.0

※項目の意味
・外横・・本体横サイズ（ふたを閉じて計測）
・外奥・・本体縦サイズ（ふたを閉じて計測）

・中横・・画面横サイズ（ふたを開いて計測）
・中縦・・画面縦サイズ（ふたを開いて計測）
・中斜・・画面対角線（ふたを開いて計測）

どれが「Ａ４」で、どれが「Ｂ５」？？

E-Mail

> なぜ、下位フォルダーを検索(取得)しないのか・・・？
> それは、単にエクスプローラの表示を取得してるからなのでした。

なんか非常にいい加減だけれど、Function FolderList(Path) 以下は
そのまま使うようにして次のような感じで？

'-----------------------------------------------------------------------
Option Explicit
'On Error Resume Next

Dim Arg, WS, FS, SH, File, Path, Ret
Set Arg = WScript.Arguments
Set WS  = WScript.CreateObject("WScript.Shell")
Set FS  = WScript.CreateObject("Scripting.FileSystemObject")
Set SH  = WScript.CreateObject("Shell.Application")

Dim Shell
Dim wShell
Dim k
Dim COL:COL=50

If Arg.Count = 1 Then
  Path = Arg(0)
  If FS.FolderExists(Path) Then
    call FolderList(Path)

  Else
    Ret = WS.Popup( "オプション指定に間違いがあります！" _
                   , 3 _
                   , "確認" _
                   , 0)
  End If
Else
  Ret = WS.Popup( "フォルダを指定して下さい！" _
                 , 3 _
                 , "確認" _
                 , 0)
End If

Set SH  = Nothing
Set FS  = Nothing
Set WS  = Nothing
Set Arg = Nothing
WScript.Quit

'-----------------------------------------------------------------------
Function FolderList(Path)
  Dim f, f1, subf, Folder
  Path = FS.GetAbsolutePathName(Path)
  Set f = FS.GetFolder(Path)
  'すべてのファイルを表示
  Set Folder=SH.NameSpace(Path)
  call FileList(Path,Folder)
  'すべてのサブフォルダを表示
  For Each subf In f.SubFolders
      call FolderList(subf.Path)
  Next
End Function
'-----------------------------------------------------------------------
Function FileList(arg,Folder)
Dim StdOut
Dim tFolder
Dim tName
Dim tPath
Dim tCOL
Dim k
Dim w
ReDim wa(COL)
Dim FolderItem

Set FolderItem=Nothing
k=0
On Error Resume Next
Set FolderItem=Folder.Items.Item
k=Folder.Items.Count
On Error Goto 0
If FolderItem Is Nothing Then
  If k=0 Then
    WScript.Echo arg,"Is Not Folder."
  Else
    arg=Folder.Title
  End If
Else
  arg=FolderItem.Path
End If
If Left(arg,2)="::" Then arg=Folder.Title & " " & arg

If UCase(FS.GetBaseName(WScript.FullName))="CSCRIPT" Then
  Set StdOut=WScript.StdOut
Else
  Set tFolder=FS.GetSpecialFolder(2)
  tName=FS.GetBaseName(FS.GetTempName()) & ".TXT"
  tPath=FS.BuildPath(tFolder.Path,tName)
  Set StdOut=tFolder.CreateTextFile(tName)
End If

StdOut.WriteBlankLines 1
StdOut.WriteLine arg
StdOut.WriteBlankLines 1

For Each FolderItem In Folder.Items
  For k=0 To COL
    w=LenA(Folder.GetDetailsOf(FolderItem,k))
    If wa(k)<w Then wa(k)=w
  Next
Next

For k=0 To COL
'  WScript.Echo i,Folder.GetDetailsOf(,k)
  If wa(k)>0 Then
    w=LenA(Folder.GetDetailsOf(,k))
    If wa(k)<w Then wa(k)=w
  End If
Next
For tCOL=COL To 0 Step -1
  If wa(tCOL)>0 Then Exit For
Next

For k=0 To tCOL
  If wa(k)>0 Then
    StdOut.Write Pad(Folder.GetDetailsOf(,k),wa(k))
    If k<tCOL Then
      StdOut.Write " "
    Else
      StdOut.Write vbCRLF
    End If
  End If
Next

For Each FolderItem In Folder.Items
  For k=0 To tCOL
    If wa(k)>0 Then
      StdOut.Write Pad(Folder.GetDetailsOf(FolderItem,k),wa(k))
      If k<tCOL Then
        StdOut.Write " "
      Else
        StdOut.Write vbCRLF
      End If
    End If
  Next
Next

If UCase(FS.GetBaseName(WScript.FullName))="CSCRIPT" Then
Else
  StdOut.Close
  wShell.Run "NotePad.EXE " & tPath
  Do While Not wShell.AppActivate(tName)
    WScript.Sleep 100
  Loop
  WScript.Sleep 100
  FS.DeleteFile tPath
End If
End Function

Function Pad(str,n)
  Dim m
  m=n-LenA(str)
  If m<0 Then m=0
  Pad=str & string(m," ")
End Function

Function LenA(str)
  Dim k
  For k=1 To Len(str)
    If Asc(Mid(str,k,1))<0 Then
      LenA=LenA+2
    Else
      LenA=LenA+1
    End If
  Next
End Function

Sub SpecialFolders()
For k=1 To 50
  Set Folder=Shell.NameSpace(k)
  If Folder Is Nothing Then
  Else
    WScript.StdOut.WriteLine k
    WScript.StdOut.WriteLine Folder.Title
    WScript.StdOut.WriteLine Folder.Items.Item.Path
  End If
Next
End Sub
'-----------------------------------------------------------------------