Sub Sample01()
    Dim FSO, DrvLetter As String, msg As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    DrvLetter = InputBox("容量を調べるドライブは？")
    If DrvLetter = "" Then
        Set FSO = Nothing
        Exit Sub
    End If
    If FSO.DriveExists(DrvLetter) Then
        With FSO.GetDrive(DrvLetter)
            msg = Format(.AvailableSpace / 1024, "#,##") & " KB"
        End With
    MsgBox DrvLetter & "ドライブの空き容量は、" & msg & "です。", vbInformation
    Else
        MsgBox DrvLetter & "ドライブは存在しません", vbExclamation
    End If
    Set FSO = Nothing
End Sub

Sub Sample02()
    Dim FSO, Drv, cnt As Long, DrvType As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''全てのドライブを調べます
    For Each Drv In FSO.Drives
        cnt = cnt + 1
        Select Case Drv.DriveType
            Case 0:  DrvType = " 不明"
            Case 1:  DrvType = " リムーバブルディスク"
            Case 2:  DrvType = " ハードディスク"
            Case 3:  DrvType = " ネットワークドライブ"
            Case 4:  DrvType = " CD-ROM"
            Case 5:  DrvType = " RAMディスク"
        End Select
        ''シートに書き込みます
        ActiveSheet.Cells(cnt, 1) = Drv.DriveLetter
        ActiveSheet.Cells(cnt, 2) = DrvType
    Next Drv
    Set FSO = Nothing
End Sub

Sub Sample03()
    Dim FSO, StartNum As Long, EndNum As Long, i As Long
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Workフォルダの存在を調べます
    If FSO.FolderExists("C:\Work\") = False Then
        MsgBox "C:\Workフォルダを作ってから実行してください", vbExclamation
        Set FSO = Nothing
        Exit Sub
    End If
    ''開始数字と終了数字をユーザーから受け取ります
    StartNum = Val(InputBox("連続番号フォルダの開始番号は？"))
    EndNum = Val(InputBox("連続番号フォルダの終了番号は？"))
    If StartNum = 0 Or EndNum = 0 Then Exit Sub
    ''連続番号フォルダを作成します
    ''同名フォルダが存在する場合のエラーを無視します
    On Error Resume Next
    For i = StartNum To EndNum
        FSO.CreateFolder "C:\Work\" & Format(i, "000")
    Next i
    MsgBox Format(StartNum, "000") & "から" & _
           Format(EndNum, "000") & _
           "のフォルダを作成しました", vbInformation
    Set FSO = Nothing
End Sub

Sub Sample04()
    Dim FSO, LargeNum As Long, Fil
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Workフォルダの存在を調べます
    If FSO.FolderExists("C:\Work\") = False Then
        MsgBox "C:\Workフォルダを作ってから実行してください", vbExclamation
        Set FSO = Nothing
        Exit Sub
    End If
    ''C:\Work内の全てのサブフォルダから最大番号を調べます
    For Each Fil In FSO.GetFolder("C:\Work\").SubFolders
        If LargeNum < Val(Fil.Name) Then LargeNum = Val(Fil.Name)
    Next Fil
    FSO.Createfolder "C:\Work\" & Format(LargeNum + 1, "000")
    MsgBox Format(LargeNum + 1, "000") & "フォルダを作成しました", vbInformation
    Set FSO = Nothing
End Sub

Sub Sample05()
    Dim FSO, TempFolder As String, TempName As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''新しいブックを挿入します
    With Workbooks.Add
        ''作業用ブック名を生成します
        With FSO
            TempName = .GetSpecialFolder(2) & "\" & .GetBaseName(.GetTempName) & ".xls"
        End With
        ''挿入したブックに名前を付けて保存します
        .SaveAs TempName
        MsgBox .FullName & vbCrLf & "という名前で保存しました", vbInformation
    End With
    Set FSO = Nothing
End Sub

Sub Sample06()
    Workbooks.Add
    Call WriteLog("新しいブックを開きました")
    Range("A1") = 123
    Call WriteLog("セルにデータを書き込みました")
    ActiveWorkbook.SaveAs "C:\Work\Report.xls"
    Call WriteLog("ブックを保存しました")
End Sub


Sub WriteLog(msg As String)
    Dim FSO, LOG
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''ログファイルがなければ作ります
    If FSO.FileExists("C:\Work\Report.log") = False Then
        FSO.CreateTextFile "C:\Work\Report.log"
    End If
    ''追記で開きます
    Set LOG = FSO.OpenTextFile("C:\Work\Report.log", 8)
    ''日時＋タブ＋メッセージを書き込みます
    LOG.WriteLine Now & Chr(9) & msg
    Set FSO = Nothing
End Sub

Sub Sample07()
    Dim FSO, f, BaseNames() As String, cnt As Long, i As Long
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each f In FSO.GetFolder("C:\Work\").Files
        If LCase(FSO.GetExtensionName(f.Name)) = "xls" Then
            cnt = cnt + 1
            ReDim Preserve BaseNames(cnt)
            BaseNames(cnt) = FSO.GetBaseName(f.Name)
        End If
    Next f
    If cnt = 0 Then
        MsgBox "xlsファイルはありません", vbExclamation
        Set FSO = Nothing
        Exit Sub
    End If
    For i = 1 To cnt
        Cells(i, 1) = BaseNames(i)
    Next i
    Set FSO = Nothing
End Sub

Sub Sample08()
    Dim FSO, f, cnt As Long
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each f In FSO.GetFolder("C:\Tmp\").SubFolders
        cnt = cnt + 1
        Cells(cnt, 1) = FSO.GetFolder(f).Name
        Cells(cnt, 2) = FSO.GetFolder(f).Size
    Next f
    ''グラフの作成
    ActiveSheet.ChartObjects.Add(Range("C1").Left, Range("C1").Top, _
                                 Range("C1:G16").Width, Range("C1:G16").Height).Select
    With ActiveChart
        .ChartType = xl3DBarClustered
        .HasLegend = False
        .SetSourceData Source:=ActiveSheet.Range("A1").CurrentRegion
        .Location Where:=xlLocationAsObject, Name:=ActiveSheet.Name
        .Axes(xlCategory).ReversePlotOrder = True
    End With
    Range("A1").Activate
    Set FSO = Nothing
End Sub

Sub Sample09()
    Dim FSO, TargetFile As String
    TargetFile = Application.GetOpenFilename()
    If TargetFile = "False" Then
        Set FSO = Nothing
        Exit Sub
    End If
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With FSO.OpenTextFile(TargetFile, 8)
        MsgBox Dir(TargetFile) & "は、" & .Line & "行あります。"
        .Close
    End With
    Set FSO = Nothing
End Sub

Sub Sample10()
    Dim NewPath As String
    NewPath = InputBox("保存するフォルダのパスを入力してください" & vbCrLf & _
                       "例:C:\tmp\sub (必ずルートから)")
    ''[キャンセル]だったら終了
    If NewPath = "" Then Exit Sub
    ''親フォルダまでが存在するかチェックする
    Call CheckparentFolder(NewPath)
    ''サンプルのファイルを保存する
    If Right(NewPath, 1) <> "\" Then NewPath = NewPath & "\"
    Open NewPath & "Sample.txt" For Output As #1
        Print #1, Now()
    Close #1
End Sub

Sub CheckparentFolder(TargetFolder)
    Dim ParentFolder As String, FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''調査対象フォルダの、親フォルダ名を取得する
    ParentFolder = FSO.GetParentFolderName(TargetFolder)
    If Not FSO.FolderExists(ParentFolder) Then
        ''親フォルダが存在しなかったら、
        ''親フォルダを新しい対象フォルダとして
        ''自分自身(Sub CheckparentFolder)を呼び出す
        Call CheckparentFolder(ParentFolder)
    End If
    ''新しいフォルダを作る
    FSO.CreateFolder TargetFolder
    Set FSO = Nothing
End Sub