VBA中Shell("cmd /c md")创建文件夹无法正常运行问题求助

常见原因及对应解决方法 #

• 路径合法性问题：首先确认遍历的单元格值均为合法日期格式，无空值、文本乱码。可在生成路径后增加调试语句确认输出符合预期：

  Debug.Print strFolders ' 运行后可在VBA编辑器立即窗口查看生成的路径是否正确
  

• Shell调用冗余问题：原代码每次循环都启动一次cmd进程，遍历A1:L5共60个单元格会短时间启动60个独立进程，极易出现资源抢占卡死。建议替换为VBA原生的FileSystemObject对象完成文件夹创建，不需要额外调用cmd，稳定性和执行效率都更高。
• 网络盘权限/连接问题：X盘一般为企业网络共享盘，调用cmd访问共享盘会触发额外的权限校验逻辑，容易出现阻塞。首先手动在资源管理器访问根路径X:\Loan Committee\Boardpaq，确认当前账号有该路径的新建文件夹权限、共享盘连接正常。

优化后可直接使用的完整代码 #

Public Sub Boardpaq()
    Dim objCol As Range, objCell As Range, strFolders As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 提前校验根路径可用性，避免后续无效循环
    If Not fso.FolderExists("X:\Loan Committee\Boardpaq\") Then
        MsgBox "X盘根路径无法访问，请检查网络盘连接和权限", vbCritical
        Exit Sub
    End If
    
    For Each objCol In ThisWorkbook.Worksheets(1).Range("A1:L5").Columns
        For Each objCell In objCol.Cells
            ' 跳过非日期格式的空单元格/异常单元格
            If IsDate(objCell.Value) And Len(Trim(objCell.Value)) > 0 Then
                strFolders = "X:\Loan Committee\Boardpaq\" & Format(objCell, "yyyy") & _
                            "\" & Format(objCell, "mm-yyyy") & "\" & Format(objCell, "mm-dd-yy")
                ' 文件夹已存在则跳过创建，避免报错
                If Not fso.FolderExists(strFolders) Then
                    fso.CreateFolder strFolders
                End If
            End If
        Next
    Next
    Set fso = Nothing
    MsgBox "所有文件夹创建完成", vbInformation
End Sub

内容的提问来源于stack exchange，提问作者A Cohen