时间戳

首页 > 解决方案 > 在创建文件夹之前检查 VBA Access 中目录的权限

ms-access - 在创建文件夹之前检查 VBA Access 中目录的权限

问题描述

我正在尝试使用 VBA 在 Microsoft Access 数据库中实现某个功能，因此当按下某个按钮时，它将首先检查服务器中文件夹的可用性。如果该文件夹不存在，将创建相应的文件夹。但是，这些文件夹附加了权限，这意味着只有某些用户可以访问它，因此只有某些用户应该创建/访问该文件夹。我尝试了以下方法：

on error resume next
If Dir("Server/Data/Celes", vbDirectory) = "Celes" Then
Else
    MkDir ("Server/Data/Celes")
End If

但我不确定这是否是处理这个问题的最佳方法。我使用“On Error Resume Next”，这样如果由于文件夹（已经存在）的权限不足而发生错误，它将忽略它。有什么更好的方法来处理这个问题？谢谢你。

我还检查了以下链接：

但他们都关心保存文件，而不是创建文件夹。

标签： ms-accessvba

解决方案

我使用以下函数递归地创建完整路径（如果需要）并返回一个指示成功或失败的值。它也适用于 UNC。 

Private Function CreateFolder(ByVal sPath As String) As Boolean
'by Patrick Honorez - www.idevlop.com
'checks for existence of a folder and create it at once, if required
'returns False if folder does not exist and could NOT be created, True otherwise
'sample usage: If CreateFolder("C:\toto\test\test") Then debug.print "OK"
'updated 20130422 to handle UNC paths correctly ("\\MyServer\MyShare\MyFolder")

    Dim fs As Object
    Dim FolderArray
    Dim Folder As String, i As Integer, sShare As String

    If Right(sPath, 1) = "\" Then sPath = Left(sPath, Len(sPath) - 1)
    Set fs = CreateObject("Scripting.FileSystemObject")
    'UNC path ? change 3 "\" into 3 "@"
    If sPath Like "\\*\*" Then
        sPath = Replace(sPath, "\", "@", 1, 3)
    End If
    'now split
    FolderArray = Split(sPath, "\")
    'then set back the @ into \ in item 0 of array
    FolderArray(0) = Replace(FolderArray(0), "@", "\", 1, 3)
    On Error GoTo hell
    'start from root to end, creating what needs to be
    For i = 0 To UBound(FolderArray) Step 1
        Folder = Folder & FolderArray(i) & "\"
        If Not fs.FolderExists(Folder) Then
            fs.CreateFolder (Folder)
        End If
    Next
    CreateFolder = True
hell:
End Function

推荐阅读