テスト28

'ファイルの存在と開かれているかのチェック
Sub File()

Dim F_Path() As Variant
Dim fso As Variant
Dim ExName As String

Set fso = CreateObject("Scripting.FileSystemObject")

ReDim Preserve F_Path(2)

'拡張子を格納
ExName = fso.GetExtensionName(FilePath)

'各パスを格納
With ThisWorkbook.Sheets("Sheet6")

    F_Path(0) = .Cells(1, 1).Value
    F_Path(1) = .Cells(2, 1).Value
    F_Path(2) = .Cells(3, 1).Value

End With


For i = LBound(F_Path) To UBound(F_Path)

ExName = fso.GetExtensionName(F_Path(i))

    If ExName <> "" Then
        'パスがファイル(拡張子がある場合)の時はファイルチェック
        Call File_Check(F_Path(i))

    Else
        'パスがフォルダ(拡張子がない場合)の時はファイルチェック
        Call Folder_Check(F_Path(i))

    End If

    ExName = ""

Next i


MsgBox "問題ありません", vbCritical



End Sub

Sub File_Check(ByVal strPath As String)

'ファイルチェック
Dim fso As Variant
Dim s As String

Set fso = CreateObject("Scripting.FileSystemObject")

' ファイル名と拡張子(パス上にファイルがなくてもファイル名が取得できる)
s = fso.GetFileName(strPath)

'ファイルの存在チェック
If Dir(strPath) = "" Then
    '問題なければ何もしない

    MsgBox s & "が存在しません。もう一度確認してください。", vbCritical
    End

End If

'-------------------------------------------------------------
'ファイルが開かれているかのチェック(ファイルの場合に処理を実行する)
On Error Resume Next

Open strPath For Append As #1
Close #1

If Err.Number > 0 Then

    MsgBox s & "がすでに開かれています。もう一度確認してください。", vbCritical
    End

Else
    '問題がなければ何もしない
    On Error GoTo 0

End If

End Sub

Sub Folder_Check(ByVal strPath As String)

'フォルダチェック

Set fso = CreateObject("Scripting.FileSystemObject")

' ファイル名と拡張子(パス上にファイルがなくてもファイル名が取得できる)
s = fso.GetBaseName(strPath)


If Dir(strPath, vbDirectory) = "" Then
    '問題なければ何もしない

    MsgBox s & "フォルダが存在しません。もう一度確認してください。", vbCritical
    End

End If

End Sub