Global FileSystem As Variant

' ******************************************************
' 初期化
' ******************************************************
Public Function FsInit()

    If Not IsObject(FileSystem) Then
        Set FileSystem = CreateObject("Scripting.FileSystemObject")
    End If

End Function

' ******************************************************
' ファイルの読み込みオープン
' ******************************************************
Public Function FsReadOpen(strFileName As String) As Object

    Call FsInit

    Set FsReadOpen = FileSystem.OpenTextFile(strFileName, 1)

End Function

' ******************************************************
' ファイルの書き込みオープン
' ******************************************************
Public Function FsWriteOpen(strFileName As String) As Object

    Call FsInit

    Set FsWriteOpen = FileSystem.CreateTextFile(strFileName, 1)

End Function

' ******************************************************
' クローズ
' ******************************************************
Public Function FsClose(ByRef fp As Object)

    fp.Close
    Set fp = Nothing

End Function

' ******************************************************
' EOF
' ******************************************************
Public Function FsEof(ByRef fp As Object) As Boolean

    FsEof = fp.AtEndOfStream

End Function

' ******************************************************
' ファイルの複写
' ******************************************************
Public Function FsCopy(strFrom As String, strTo As String)

    Call FsInit

    FileSystem.CopyFile strFrom, strTo, True

End Function

' ******************************************************
' テンポラリディレクトリの取得
' ******************************************************
Public Function FsGetTmp() As String

    Call FsInit

    FsGetTmp = FileSystem.GetSpecialFolder(2)

End Function

' ******************************************************
' 存在チェック
' ******************************************************
Public Function FsExist(Spec As String, nType As Integer) As Boolean

    Call FsInit
    
    Select Case nType
        Case 0  ' ファイル
            FsExist = FileSystem.FileExists(Spec)
        Case 1  ' ディレクトリ
            FsExist = FileSystem.FolderExists(Spec)
        Case 2  ' ドライブ
            FsExist = FileSystem.DriveExists(Spec)
    End Select

End Function

' ******************************************************
' ディレクトリ作成
' ******************************************************
Public Function FsMkDir(Spec As String)

    Call FsInit

    Dim i
    Dim strParent As String

    strParent = Spec

    On Error Resume Next
    FileSystem.CreateFolder Spec
    On Error GoTo 0
    If FsExist(Spec, 1) Then
        Exit Function
    End If
    strParent = FileSystem.GetParentFolderName(Spec)
    If strParent = "" Then
        Exit Function
    End If
    
    Do While Not FsExist(strParent, 1)
        
        strParent = FileSystem.GetParentFolderName(strParent)
        If strParent = "" Then
            Exit Do
        End If
        
        On Error Resume Next
        FileSystem.CreateFolder strParent
        On Error GoTo 0
    
        strParent = Spec
        On Error Resume Next
        FileSystem.CreateFolder strParent
        On Error GoTo 0
    
    Loop

End Function

' ******************************************************
' ディレクトリ削除
' ******************************************************
Public Function FsRmDir(Spec As String, Force As Boolean)

    Call FsInit

    On Error Resume Next
    FileSystem.DeleteFolder Spec, Force
    On Error GoTo 0

End Function


' ******************************************************
' カレントディレクトリ取得
' ******************************************************
Public Function FsGetCurDir() As String

    Call FsInit

    FsGetCurDir = FileSystem.GetAbsolutePathName(".")

End Function

' ******************************************************
' 指定ディレクトリ内のファイル一覧
' ******************************************************
Public Function FsGetFiles(Grid As Object, TargetDir As String)

    Call FsInit
    
    Dim oFolder
    Dim oFc
    Dim oFcw

    Set oFolder = FileSystem.GetFolder(TargetDir)
    Set oFc = oFolder.Files
    
    Grid.Cols = 3
    Grid.Clear
    
    Dim i
    
    i = 1
    
    For Each oFcw In oFc
        Grid.Rows = i + 1
        Grid.TextMatrix(i, 1) = oFcw.Name
        i = i + 1
    Next

    Grid.Sort = 1

End Function

' ******************************************************
' 使用されていないドライブを取得
' ******************************************************
Public Function FsGetFreeDrive(nType As Long) As String

    Call FsInit
    
    Dim i
    Dim TargetDrive

    If nType = 0 Then
        For i = &H44 To &H5A
            On Error Resume Next
            Set TargetDrive = FileSystem.GetDrive(Chr(i) & ":")
            If Err.Number <> 0 Then
                FsGetFreeDrive = Chr(i) & ":"
                Exit Function
            End If
        Next
    Else
        For i = &H5A To &H44 Step -1
            On Error Resume Next
            Set TargetDrive = FileSystem.GetDrive(Chr(i) & ":")
            If Err.Number <> 0 Then
                FsGetFreeDrive = Chr(i) & ":"
                Exit Function
            End If
        Next
    End If

End Function

' ******************************************************
' ファイルの削除
' ******************************************************
Public Function FsDeleteFile(TargetFile) As String

    Call FsInit

    Call FileSystem.DeleteFile(TargetFile, True)

End Function

Private Sub Command1_Click()


    Set fp = FsReadOpen(App.Path & "\" & "test.txt")
    Set ofp = FsWriteOpen(App.Path & "\" & "test2.txt")

    Do While Not FsEof(fp)
    
        ofp.WriteLine fp.ReadLine
    
    Loop

    FsClose ofp
    FsClose fp

End Sub