在创建文件夹之前检查 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 已损坏?