Sub ファイル1_1()
    MsgBox "ブック名の読み取り→ " & ActiveWorkbook.Name
End Sub

Sub ファイル1_2()
    MsgBox "最後に開いたbook名読み取り→ " & ActiveWindow.Caption
End Sub

Sub ファイル1_3()
    MsgBox "パスを含むブック名→ " & ActiveWorkbook.FullName
End Sub

Sub ファイル2_1()
    MsgBox "カレントフォルダ→　" & Application.DefaultFilePath
End Sub

Sub ファイル2_2()
    MsgBox "実行中のマクロBookのパス→　" & ThisWorkbook.Path
End Sub

Sub ファイル2_3()
    MsgBox "カレントパス→ " & CurDir()
End Sub

Sub ファイル3_1()
Dim dva As String
    phn = ActiveWorkbook.Path
        dva = Left(phn, 2)
    ChDrive dva    'ドライブの変更
 
MsgBox "アクティブブックのドライブ「" & dva & "」を" & Chr(10) & _
       "カレントドライブに設定しました。"
End Sub

Sub ファイル3_2()
Dim dra As String
    phn = ActiveWorkbook.Path
        dra = Mid(phn, 3)
    ChDir dra      'フォルダの変更
 
MsgBox "アクティブブックのフォルダ「" & dra & "」を" & Chr(10) & _
       "カレントフォルダに設定しました。"
End Sub

Sub ファイル3_3()
Dim phn As String
phn = ActiveWorkbook.Path
    On Error Resume Next
       RmDir phn & "\MyGIF" 'フォルダの削除
    On Error GoTo 0
    MkDir phn & "\MyGIF"  'エラー回避に既にある場合は上記で削除
 
MsgBox phn & "(アクティブブックと同じ場所）へ" & Chr(10) & _
    "フォルダ名「MyGIF」のフォルダを追加しました。"
End Sub

Sub ファイル3_4()
Dim phn As String
phn = ActiveWorkbook.Path
    On Error Resume Next
       RmDir phn & "\MyGIF" 'フォルダの削除
        If Err = 76 Then
            MsgBox "削除するフォルダ「MyGIF」はありません。"
        Else
            MsgBox phn & "のフォルダ「MyGIF」を削除しました。"
        End If
End Sub

Sub ファイル4_1()
Dim fff As String
    fff = Application.GetOpenFilename()
    MsgBox "フルパスからファイル名を取り出し→" & Dir(fff)
End Sub
-------------------------------------------------------------
Sub ファイル4_1a()
Dim fff As String
    fff = Application.GetOpenFilename()
    fa = Mid(fff, 1, InStrRev(fff, "\") - 1)
    MsgBox "指定ファイルの入っているフォルダ名を取り出し→" & Dir(fa, 16)
End Sub

Sub ファイル4_2()
Dim phn As String, fff As String
    phn = ActiveWorkbook.FullName
        fff = Dir(phn)
    MsgBox fff & "の作成年月日→ " & FileDateTime(phn)
End Sub

Sub ファイル4_3()
Dim phn As String, fff As String
    phn = ActiveWorkbook.FullName
        fff = Dir(phn)
    MsgBox fff & "のファイルサイズ→ " & FileLen(phn) & "バイト"
End Sub

Sub ファイル4_4()
Dim phn As String, fff As String
    phn = ActiveWorkbook.FullName
        fff = Dir(phn)
 
    SetAttr phn, vbNormal
    MsgBox fff & "の属性を「標準ファイル」に設定しました "
End Sub

Sub ファイル4_5()
Dim phn As String, fff As String
    phn = ActiveWorkbook.FullName
        fff = Dir(phn)
    MsgBox fff & "ファイルの属性→　" & GetAttr(phn)
　0:標準､1: 読み込み専用､2: 隠しファイル､4: システム､16: フォルダ
End Sub

Sub ファイル5_1()
Dim txtpas As String
txtpas = ThisWorkbook.Path
 
    FileCopy txtpas & "\" & "Book1.xls", txtpas & "\MyBook.xls"
 
MsgBox "Book1.xls" & "をコピーして同じフォルダへ" & Chr(10) & _
    "ファイル名「MyBook.xls」で貼り付けました。"
End Sub

Sub ファイル5_2()
Dim txtpas As String
txtpas = ThisWorkbook.Path
    On Error Resume Next
        Name txtpas & "\MyBook.xls" As txtpas & "\Book99.xls"
    If Err = 58 Then
        MsgBox "ファイル名「Book99」にありので同じ名前には変更できません。"
        Exit Sub
     ElseIf Err = 53 Then
        MsgBox "名前を変更するファイル名が見つかりません。"
        Exit Sub
    End If
 
MsgBox "「MyBook.xls」のファイル名を" & Chr(10) & _
    "ファイル名「Book99.xls」に変更しました。"
End Sub

Sub ファイル5_3()
Dim txtpas As String
txtpas = ThisWorkbook.Path
    On Error Resume Next
        Kill txtpas & "\Book99.xls"
    If Err = 53 Then
        MsgBox "削除するファイル名「Book99」はありません。"
        Exit Sub
    End If
MsgBox "「Book99.xls」を削除しました。"
End Sub