A列に記載したフォルダが書き込み可能かを調べてB列に記載するマクロ

Sub CheckAccess()
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row ' A列の最終行を取得
    
    For i = 1 To lastRow ' A列の各セルについて処理を繰り返す
        If FolderAccess(Cells(i, "A").Value) Then ' フォルダに書き込み権限がある場合
            Cells(i, "B").Value = "〇"
        Else ' 書き込み権限がない場合
            Cells(i, "B").Value = "×"
        End If
    Next i
End Sub

Function FolderAccess(FolderPath As String) As Boolean
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If fso.FolderExists(FolderPath) Then ' フォルダが存在する場合
        Dim tempFile As Object
        On Error Resume Next
        Set tempFile = fso.CreateTextFile(FolderPath & "\test.txt", True) ' テストファイルを作成
        On Error GoTo 0
        
        If Not tempFile Is Nothing Then ' ファイルの作成に成功した場合
            tempFile.Close
            fso.DeleteFile (FolderPath & "\test.txt") ' テストファイルを削除
            FolderAccess = True
        Else ' ファイルの作成に失敗した場合
            FolderAccess = False
        End If
    Else ' フォルダが存在しない場合
        FolderAccess = False
    End If
    
    Set fso = Nothing
End Function