Question

我正在尝试使用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”，因此，如果由于缺少对文件夹的权限（已存在）而发生错误，它将忽略它。有什么更好的方法来解决这个问题？谢谢。

我还检查了以下链接：

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

Answer 1

几天没有成功之后，终于找到了解决方案：

Private function canAccess(path as string) as boolean
    Dim oShell As Object
    Set oShell = CreateObject("WScript.Shell")

    Dim result As Integer
    Dim command As String
    command = "icacls " & """" & pfad & """"
    result = oShell.Run(command, 0, True)
    'Check privilege; file can be accessed if error code is 0.
    'Else, errors are encountered, and error code > 0.

    If result <> 5 and result <> 6 Then
        KannAufDateiZugreifen = True
    Else
        KannAufDateiZugreifen = False
    End If
end function

private sub button_click()
    if canAccess ("Server/Data/Celes") then
        If Dir("Server/Data/Celes", vbDirectory) = "Celes" Then
        Else
            MkDir ("Server/Data/Celes")
        end if
    End If
end sub

函数“ canAccess”将模拟Windows shell的运行，并执行“ icacls”以查看是否可以访问该文件。如果该函数返回true，则表示“ icacls”命令成功，这意味着可以访问该文件夹。否则，无法访问文件/文件夹。

我很确定可以对此进行改进，但是现在可以了。

Answer 2

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

    <div class="col-xs-12" id="JSONContainer"
        [innerHTML]="data | textHighlight:query">
    </div>

Answer 3

'Must set a Reference to the Microsoft Scripting Runtime

Dim fso As FileSystemObject

 Dim fil As File
 Set fso = New Scripting.FileSystemObject

 If fso.FileExists("\\serverName\folderName\fileName.txt") Then
   'code execution here
 Else
   MsgBox "File and/or Path cannot be found", vbCritical, "File Not Found"
 End If

创建文件夹之前，请检查VBA Access中目录的权限

3 个答案: