VBA shell explorer.exe打开文件夹时，如果没有权限会自动打开“我的文档”

Question

VBA shell explorer.exe打开文件夹时，如果没有权限会自动打开“我的文档”，怎么不让VBA打开文件夹时候，如果路径没有访问权限时，就弹出msgbox提示一下就行，不打开“我的文档”，谢谢

Answer 1

引自免费微信小程序：皆我百晓生

在VBA中，你可以通过调用Shell函数来启动一个外部程序，例如explorer.exe并指定要打开的文件夹路径。为了实现当没有权限打开指定文件夹时显示消息框的功能，你需要在尝试打开文件夹之前检查其访问权限。

首先，我们需要一个辅助函数来检查文件夹的访问权限。这个功能在Windows系统中通常由操作系统本身处理，但我们可以借助Python的psutil库来实现。安装这个库的命令是：pip install psutil

然后，我们将创建一个Python脚本（命名为check_access.py）来执行此操作：

import os
import psutil


def check_folder_access(path):
    try:
        proc = psutil.Popen(['cmd', '/c', 'dir', path], stdout=psutil.PIPE, stderr=psutil.PIPE)
        _, _ = proc.communicate()
        return True
    except (FileNotFoundError, PermissionError):
        return False

接下来，在VBA中引用这个Python脚本，并在尝试打开文件夹前调用它。以下是完整的VBA代码：

Sub OpenFolderWithPermissionCheck(folderPath As String)
    Dim pythonScript As String
    Dim result As Boolean
    
    ' 定义Python脚本路径
    pythonScript = "C:\path\to\your\check_access.py" ' 请替换为实际路径
    
    ' 调用Python脚本检查文件夹权限
    result = CheckPythonScript(pythonScript, folderPath)
    
    If result Then
        ' 如果有权限，使用Shell函数打开文件夹
        Shell "explorer.exe """ & folderPath & """", vbNormalFocus
    Else
        ' 如果无权限，显示消息框
        MsgBox "没有足够的权限打开文件夹，请联系管理员。"
    End If
End Sub


' VBA函数，用于调用Python脚本
Function CheckPythonScript(scriptPath As String, folderPath As String) As Boolean
    Dim pythonCmd As String
    pythonCmd = "python " & scriptPath & " " & folderPath
    
    ' 执行Python脚本并获取结果
    On Error Resume Next
    With CreateObject("WScript.Shell")
        CheckPythonScript = (.Exec(pythonCmd).StdOut.ReadAll Like "*True*")
    End With
    On Error GoTo 0
End Function

确保将pythonScript变量中的路径更改为包含check_access.py的实际路径。这段代码首先会调用Python脚本来检查给定的文件夹路径是否有访问权限，如果有权限则打开文件夹，否则显示消息框。

请注意，这种方法依赖于Python环境以及psutil库的可用性。如果你的环境中没有这些，可能需要额外配置。