基于VBA的批量创建员工文件夹并授权的CMD命令执行需求

嘿，我来帮你搞定这个用于新员工文件夹创建的VBA工具！下面是分步骤的完整实现方案，跟着做就能轻松完成需求：

先把你的Excel工作表调整成这样的结构，方便后续操作：

• 把A2到A10设为「用户ID输入区」——每行输入一个新员工的ID就行
• D6到D10会自动生成可直接在CMD执行的命令（和A列的ID一一对应，A2对应D6，A3对应D7，以此类推）

方式1：用Excel公式快速实现 #

直接在D6单元格输入下面的公式，然后下拉到D10即可：

=IF(A2<>"", "md ""\\你的共享盘根路径\员工文件夹\"&A2&""" && icacls ""\\你的共享盘根路径\员工文件夹\"&A2&""" /grant 你的域名\"&A2&":(OI)(CI)F", "")

提示：把公式里的\\你的共享盘根路径\员工文件夹\换成实际的文件夹根目录，你的域名换成公司AD域的域名（比如COMPANY）。这个命令会同时创建文件夹并给对应员工分配完全控制的权限。

方式2：用VBA事件自动生成（更智能） #

如果想要输入ID后自动实时生成命令，右键点击工作表标签→选择「查看代码」，粘贴下面的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 只监听A2到A10的输入变化
    If Not Intersect(Target, Me.Range("A2:A10")) Is Nothing Then
        ' 计算对应D列的行号（A2对应D6，差4行）
        Dim cmdRow As Integer
        cmdRow = Target.Row + 4
        ' 确保不超出D6-D10的范围
        If cmdRow >=6 And cmdRow <=10 Then
            If Target.Value <> "" Then
                ' 替换成你的实际路径和域名
                Dim rootPath As String
                rootPath = "\\你的共享盘根路径\员工文件夹\"
                Dim domain As String
                domain = "你的域名"
                ' 生成带权限配置的CMD命令
                Me.Range("D" & cmdRow).Value = "md """ & rootPath & Target.Value & """ && icacls """ & rootPath & Target.Value & """ /grant " & domain & "\" & Target.Value & ":(OI)(CI)F"
            Else
                ' 清空对应D列的内容
                Me.Range("D" & cmdRow).Value = ""
            End If
        End If
    End If
End Sub

1. 点击Excel顶部的「开发工具」选项卡→「插入」→选择「表单控件」里的按钮
2. 拖动鼠标在工作表合适位置画出按钮，弹出「指定宏」窗口时，点击「新建」
3. 在弹出的VBA编辑器里粘贴下面的代码：

Sub CreateEmployeeFolders()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 换成你的工作表名称（比如"员工文件夹工具"）
    Dim rootPath As String
    rootPath = "\\你的共享盘根路径\员工文件夹\" ' 替换成实际根路径
    Dim domain As String
    domain = "你的域名" ' 替换成公司AD域名
    Dim cell As Range
    Dim folderPath As String
    Dim successCount As Integer
    successCount = 0
    
    ' 遍历所有输入的用户ID
    For Each cell In ws.Range("A2:A10")
        If cell.Value <> "" Then
            folderPath = rootPath & cell.Value
            ' 检查文件夹是否已经存在
            If Dir(folderPath, vbDirectory) = "" Then
                ' 创建文件夹
                MkDir folderPath
                ' 配置权限（用icacls命令）
                Shell "cmd /c icacls """ & folderPath & """ /grant " & domain & "\" & cell.Value & ":(OI)(CI)F", vbHide
                successCount = successCount +1
            Else
                MsgBox "用户ID「" & cell.Value & "」的文件夹已存在，跳过创建。", vbInformation
            End If
        End If
    Next cell
    
    ' 弹出最终结果提示
    If successCount > 0 Then
        MsgBox "✅ 成功创建并配置了 " & successCount & " 个员工文件夹！", vbInformation
    Else
        MsgBox "⚠️ 没有可创建的文件夹，请检查用户ID输入是否正确。", vbExclamation
    End If
End Sub

4. 回到Excel，修改按钮的显示文字（比如改成「一键创建员工文件夹」）

• 把工作簿保存为启用宏的工作簿（.xlsm格式），不然宏会失效
• 打开文件时，记得在安全提示里选择「启用内容」，这样宏才能正常运行
• 如果是共享盘路径，确保你有足够的权限创建文件夹和设置权限

内容的提问来源于stack exchange，提问作者Christopher Leandro Kwok