Dim Full As String    'fullpathを受け取るフラグ
Dim second As String  'さらにFullを内容を受け取るフラグ(同じファイルの二度の読込を防ぐ)
'書込み専用
Private Sub Command1_Click()

    Dim fnum As Integer
    
    fnum = FreeFile
    
    'Fullのなかもテキストボックス2も空じゃない場合
    '= 上書きと新規作成を同時に行おうとしている時
    If Full <> "" And Text2.Text <> "" Then
        MsgBox ("上書きか、新規作成かどちらかにしてください。")
        Full = ""
        Exit Sub  'このプロシージャを抜け出す
    End If
    
    'なにも指定していない時
    If Full = "" And Text2.Text = "" Then
        MsgBox ("ちゃんと指定してください。")
        Exit Sub  'このプロシージャを抜け出す
    End If
    
    'Fullの中身が存在し、かつテキスト2が空の場合
    If Full <> "" And Text2.Text = "" Then
        'すでに存在するファイルのみ限定し上書きする時
        If MsgBox("ファイルを上書きしますか?", vbYesNo) = vbNo Then
            Exit Sub 'このプロシージャを抜け出す
        End If
        'yesの処理
        Open Full For Output As #fnum
           
            Print #fnum, Text1.Text
        Close #fnum
    
    End If
    
    'Fullの中身が空でかつテキスト2のファイルが指定してある場合
    '　＝　新規作成
    If Full = "" And Text2.Text <> "" Then
        'ファイル名を右端から4文字見て、".txt"じゃなかったらエラー
        If Right(Text2.Text, 4) = ".txt" Then
            
            If MsgBox(File1.Path & "\" & Text2.Text & "で新規作成します、よろしいですか？", vbYesNo) = vbNo Then
                Full = ""
                Exit Sub  'このプロシージャを抜け出す
        
            Else '作成するファイルがすでに存在していたら
                If Dir(File1.Path & "\" & Text2.Text) <> "" Then
                    If MsgBox("それと同じ名のファイルがすでに存在します、上書きしますか？", vbYesNo) = vbNo Then
                        Full = ""
                        Exit Sub  'このプロシージャを抜け出す
                    Else
                        Open File1.Path & "\" & Text2.Text For Output As #fnum
        
                            Print #fnum, Text1.Text
        
                        Close #fnum
                    
                    End If
                End If
                    
            Open File1.Path & "\" & Text2.Text For Output As #fnum
        
                Print #fnum, Text1.Text
        
            Close #fnum
              
            
            End If
        
        Else 'Right関数のエラー
            MsgBox ("拡張子は *.txtで指定してください。")
            Exit Sub
    
        End If
    
    End If
End Sub
'読込
Private Sub Command2_Click()
    
    'Pathが未指定の時またはファイルがすでに
    '開かれている時のエラー
    If Full = "" Then
        MsgBox ("ちゃんと指定していません。")
        Exit Sub
    End If
    
    If second = Full Then
        MsgBox ("そのファイルはすでに読み込まれています。")
        Full = ""
        Exit Sub
    End If
    
    Text1.Text = ""
    
    Dim mystr As String
    Dim fnum As Integer
    
    fnum = FreeFile
    
    Open Full For Input As #fnum
    
    Do While Not EOF(fnum)
        Line Input #fnum, mystr
        Text1.Text = Text1.Text & mystr & vbCrLf
    Loop
    MsgBox ("ちゃんと読み込まれました。")
    Close #fnum
    second = Full
End Sub
'テキストボックス1の内容をプリントアウトする
Private Sub Command3_Click()
    Printer.Print Text1.Text
    Printer.EndDoc
End Sub
'以下の内容をクリア
Private Sub Command4_Click()
    Text1.Text = ""
    Text2.Text = ""
    Full = ""
    second = ""
    Text1.SetFocus
End Sub
'終了
Private Sub Command5_Click()
    End
End Sub

Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
    
    Dim fnum As Integer
    
    If Right(File1.Path, 1) = "\" Then
        fullpath = File1.Path & File1.FileName
    Else
        fullpath = File1.Path & "\" & File1.FileName
    End If
    Full = fullpath 'fullpathをFullへ渡す
End Sub