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

Posted

技术标签:

【中文标题】在创建文件夹之前检查 VBA Access 中目录的权限【英文标题】:Check permission of the directory in VBA Access before creating folder 【发布时间】:2018-07-12 08:08:37 【问题描述】:

我正在尝试使用 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”,这样如果由于文件夹(已经存在)的权限不足而发生错误,它将忽略它。有什么更好的方法来处理这个问题?谢谢。

我还检查了以下链接:

https://social.msdn.microsoft.com/Forums/office/en-US/a79054cb-52cf-48fd-955b-aa38fd18dc1f/vba-verify-if-user-has-permission-to-directory-before-saveas-attempt?forum=exceldev Check Folder Permissions Before Save VBA

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

【问题讨论】:

This answer 显示了检查文件夹权限的代码。只需根据您的需要进行调整。您不想保存工作簿,因此在您的情况下,您可能需要If (process to check permissions) then (process to create the folder) 【参考方案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”命令成功,表示可以访问该文件夹。否则无法访问文件/文件夹。

我很确定这可以改进,但现在,它有效。

【讨论】:

【参考方案2】:

我使用以下函数递归地创建完整路径(如果需要)并返回一个指示成功或失败的值。它也适用于 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

【讨论】:

【参考方案3】:

'必须设置对 Microsoft 脚本运行时的引用

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 中目录的权限的主要内容,如果未能解决你的问题,请参考以下文章

MS Access 2003 - 创建 MDE 文件失败:错误 VBA 已损坏?

VBA脚本检查MS ACCESS上是不是存在表,如果存在则删除

如何通过 Access VBA 正确访问 Excel 文件

如何使用 VBA 将 pdf 保存/导出到某个文件夹

在 PHP 中创建安全密码哈希但检查 Access VBA

如何在 Access VBA 中检查 Excel 时间值?