Sub ki036()
  fff = Application.GetOpenFilename(Title:="名前を変更するファイルを指定")
  If fff = "False" Then
        MsgBox "ファイルを１個指定して下さい"
        Exit Sub
  End If
  ssb = 1
  Do
    ssa = InStr(ssb, fff, "\", 1)
    ssb = ssa + 1
    If ssa > 0 Then
        dai = Mid(fff, ssb)
    End If
  Loop Until ssa = 0
     ssa = Len(fff): ssb = Len(dai)
     phn = Left(fff, ssa - ssb - 1)
     fna = InputBox("変更後の名前を入力して下さい", , dai)
     Name fff As phn & "\" & fna
End Sub