Sub パス()

Dim F As String

Dim path As String

 

path = ThisWorkbook.path

MsgBox path

F = Left(path, 1)

If F = "D" Then

MsgBox F

Else

'MsgBox CurDir

MsgBox F

MsgBox "ng"

End If

End Sub

Sub Sample1()

  

 Dim FSO As Object

 Dim DriveObject As Object

 Dim dr_msg As String

  

 'FileSystemObjectを作成し変数に代入

 Set FSO = CreateObject("Scripting.FileSystemObject")

  

 '全てのドライブを対象として処理を行う

 For Each DriveObject In FSO.Drives

   'ドライブレターの取得（例 C:、D:など）

   dr_msg = dr_msg & DriveObject.DriveLetter & ":　"

   'DriveTypeプロパティでドライブ種類を取得

   '「0」不明

   '「1」リムーバルディスク

   '「2」ハードディスク

   '「3」ネットワークドライブ

   '「4」CD-ROMドライブ

   '「5」RAMディスク

   Select Case DriveObject.driveType

      Case 0: dr_msg = dr_msg & "Unknown" & vbLf & vbLf

      Case 1: dr_msg = dr_msg & "Removable disk drive" & vbLf & vbLf

      Case 2: dr_msg = dr_msg & "Hard disk drive" & vbLf & vbLf

      Case 3: dr_msg = dr_msg & "Network drive" & vbLf & vbLf

      Case 4: dr_msg = dr_msg & "CD-ROM drive" & vbLf & vbLf

      Case 5: dr_msg = dr_msg & "RAM disk" & vbLf & vbLf

   End Select

 Next

  

 'メッセージボックスで取得したドライブ種類を表示する

 MsgBox dr_msg, vbInformation

 

End Sub

 

Sub CallCheckLocalDisk()

 

    Dim filePath As String: filePath = ThisWorkbook.path

    Dim isLocalDrive As Boolean: isLocalDrive = CheckLocalDisk(a_filePath:=filePath)

 

    If isLocalDrive Then

        MsgBox ("ファイルの保存場所はローカルディスクです。")

    Else

        MsgBox ("ファイルの保存場所はローカルディスクではありません。")

    End If

 

End Sub

 

Function CheckLocalDisk(ByVal a_filePath As String) As Boolean

 

    Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")

    Dim driveName As String: driveName = FSO.GetDriveName(a_filePath)

    Dim driveType As Long

 

    'ドライブの種類を判別

    If driveName = "" Then

        driveType = 0 '不明

    Else

        driveType = FSO.GetDrive(driveName).driveType

    End If

 

    'ローカルディスクの場合True、それ以外はFalseを返す

    Select Case driveType

        Case 1: CheckLocalDisk = True 'リムーバブルディスク

        Case 2: CheckLocalDisk = True 'ハードディスク

        Case Else: CheckLocalDisk = False '不明、ネットワークドライブ、CDドライブなど

    End Select

 

End Function