プロパティとメソッド

Sub test1()
    ''全てのドライブ名を表示します
    Dim FSO, Drv, buf As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each Drv In FSO.Drives
        buf = buf & Drv.DriveLetter & vbCrLf
    Next Drv
    MsgBox buf & "が接続されています"
    Set FSO = Nothing
End Sub

Sub test2()
    ''カレントフォルダの後ろに新しいフォルダ名を追加します
    Dim FSO, buf As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    buf = InputBox("新しいフォルダ名は？")
    MsgBox FSO.BuildPath(CurDir, buf)
    Set FSO = Nothing
End Sub

Sub test3()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Tmp\フォルダのBook1.xlsを、C:\Work\フォルダにコピーします
    FSO.CopyFile "C:\Tmp\Book1.xls", "C:\Work\"
    ''C:\Tmp\フォルダのBook1.xlsを、C:\Work\フォルダにSample.xlsという名前でコピーします
    FSO.CopyFile "C:\Tmp\Book1.xls", "C:\Work\Sample.xls"
    Set FSO = Nothing
End Sub

Sub test4()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Tmp\フォルダのSubフォルダを、C:\Work\フォルダにコピーします
    FSO.CopyFolder "C:\Tmp\Sub", "C:\Work\"
    Set FSO = Nothing
End Sub

Sub test5()
    ''C:\Work\フォルダにSubフォルダを作成します。
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.CreateFolder "C:\Work\Sub"
    Set FSO = Nothing
End Sub

Sub test5_2()
    ''C:\Work\フォルダにユーザーが指定した名前のフォルダを作成します。
    Dim FSO, buf As String, Result As String
    buf = InputBox("C:\Workに作成するフォルダ名を入力してください")
    If buf = "" Then Exit Sub
    Set FSO = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Result = FSO.CreateFolder("C:\Work\" & buf)
    Set FSO = Nothing
    If Err = 0 Then
        MsgBox Result & vbCrLf & "を作成しました", vbInformation
    Else
        MsgBox Err.Description, vbExclamation
    End If
    Set FSO = Nothing
End Sub

Sub test6()
    ''C:\Work\フォルダにSample.txtを作成して現在の日時を書き込みます
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With FSO.CreateTextFile("C:\Work\Sample.txt")
        .WriteLine Now
        .Close
    End With
    Set FSO = Nothing
End Sub

Sub test7()
    ''C:\Work\Sample.txtを削除します
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.DeleteFile "C:\Work\Sample.txt"
    Set FSO = Nothing
End Sub

Sub test8()
    ''C:\Work\フォルダを削除します
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.DeleteFolder "C:\Work"
    Set FSO = Nothing
End Sub

Sub test9()
    ''Dドライブが存在するかどうか調べます
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.DriveExists("E") Then
        MsgBox "Eドライブが存在します"
    Else
        MsgBox "Eドライブは存在しません"
    End If
    Set FSO = Nothing
End Sub

Sub test10()
    ''C:\Work\Sample.txtが存在するかどうか調べます
    Dim FSO, Target As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Target = "C:\Work\Sample.txt"
    If FSO.FileExists(Target) Then
        MsgBox Target & "が存在します"
    Else
        MsgBox Target & "は存在しません"
    End If
    Set FSO = Nothing
End Sub

Sub test11()
    ''Subフォルダが存在するかどうか調べます
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists("..\Sub") Then
        MsgBox "Subフォルダが存在します"
    Else
        MsgBox "Subフォルダは存在しません"
    End If
    Set FSO = Nothing
End Sub

Sub test12()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''カレントフォルダがC:\Work\Job\Subだったとき
    ''C:\Workを返します
    MsgBox FSO.GetAbsolutePathName("../..")
    ''C:\を返します
    MsgBox FSO.GetAbsolutePathName("\")
    ''C:\Work\Reportを返します
    MsgBox FSO.GetAbsolutePathName("..\..\Report")
    Set FSO = Nothing
End Sub

Sub test13()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''Book1を返します
    MsgBox FSO.GetBaseName("C:\Work\Book1.xls")
    Set FSO = Nothing
End Sub

Sub test14()
    Dim FSO, Drv
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''Cを返します
    Set Drv = FSO.GetDrive("C:\")
    MsgBox Drv.DriveLetter
    Set FSO = Nothing
End Sub

Sub test15()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:を返します
    MsgBox FSO.GetDriveName("C:\")
    Set FSO = Nothing
End Sub

Sub test16()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''xlsを返します
    MsgBox FSO.GetExtensionName("C:\Work\Book1.xls")
    Set FSO = Nothing
End Sub

Sub test17()
    Dim FSO, FileObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Book1.xlsのサイズを返します
    Set FileObject = FSO.GetFile("C:\Book1.xls")
    MsgBox FileObject.Size
    Set FSO = Nothing
End Sub

Sub test18()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Book1.xlsを返します
    MsgBox FSO.GetFileName("C:\Work\Book1.xls")
    Set FSO = Nothing
End Sub

Sub test19()
    Dim FSO, FolderObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Work\フォルダ内にさるサブフォルダの個数を表示します
    Set FolderObject = FSO.GetFolder("C:\Work\")
    MsgBox FolderObject.SubFolders.Count
    Set FSO = Nothing
End Sub

Sub test20()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Workという文字列を返します
    MsgBox FSO.GetParentFolderName("C:\Work\Sub\")
    Set FSO = Nothing
End Sub

Sub test21()
    Dim FSO, FolderObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''Windowsフォルダ内に存在するファイルの個数を表示します
    Set FolderObject = FSO.GetSpecialFolder(0)
    MsgBox FolderObject.Files.Count
    Set FSO = Nothing
End Sub

Sub test22()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''ランダムなファイル名を表示します
    MsgBox FSO.GetTempName
    Set FSO = Nothing
End Sub

Sub test23()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Tmp\フォルダ内の*.xlsをC:\Work\フォルダに移動します
    FSO.MoveFile "C:\Tmp\*.xls", "C:\Work\"
    Set FSO = Nothing
End Sub

Sub test24()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Tmp\Sub\フォルダをC:\Work\フォルダに移動します
    FSO.MoveFolder "C:\Tmp\Sub", "C:\Work\"
    Set FSO = Nothing
End Sub

Sub test25()
    Dim FSO, TextFile, buf As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Work\Sample.txtを開いて内容を表示します
    Set TextFile = FSO.OpenTextFile("C:\Work\Sample.txt")
    buf = TextFile.ReadAll
    MsgBox buf
    Set FSO = Nothing
End Sub