使用Shell从网络驱动器导入CSV的VBA Access问题求助

看起来你在使用VBA从网络驱动器筛选指定日期后的CSV文件时遇到了卡点，我来帮你梳理并修复这个函数的问题。原代码存在几个潜在问题：比如网络路径处理不严谨、数组动态扩容的边界错误、FileSystemObject的引用依赖，还有循环变量名的笔误（你代码里的oFi应该是oFile吧？）。

修复后的完整函数 #

Function FilesAfterDate(Directory As String, FileSpec As String, AfterDate As Date) As String()
    ' 改用后期绑定，避免必须提前引用Microsoft Scripting Runtime的兼容性问题
    Dim oFS As Object
    Dim oFile As Object
    Dim listFiles() As String
    Dim i As Long
    
    i = 0
    ' 统一处理路径末尾的斜杠，兼容网络路径格式（如\\server\share）
    If Right(Directory, 1) <> "\" Then
        Directory = Directory & "\"
    End If
    
    Set oFS = CreateObject("Scripting.FileSystemObject")
    
    ' 新增网络目录存在性检查，避免因驱动器断开、路径错误导致的崩溃
    If Not oFS.FolderExists(Directory) Then
        MsgBox "指定的网络目录不存在或无法访问：" & Directory, vbExclamation
        ReDim listFiles(0 To -1) ' 返回空数组
        FilesAfterDate = listFiles
        Exit Function
    End If
    
    ' 遍历目录下符合规格的文件
    For Each oFile In oFS.GetFolder(Directory).Files
        ' 精准匹配文件扩展名，同时判断修改日期晚于指定时间
        If oFS.GetExtensionName(oFile.Path) = Replace(FileSpec, "*.", "") And oFile.DateLastModified > AfterDate Then
            ' 动态扩容数组，确保每个符合条件的文件都能被存储
            ReDim Preserve listFiles(i)
            listFiles(i) = oFile.Path
            i = i + 1
        End If
    Next oFile
    
    FilesAfterDate = listFiles
End Function

关键改进点说明 #

• 后期绑定FileSystemObject：无需手动添加引用，在不同办公环境下兼容性更强，尤其适配网络驱动器场景的权限差异。
• 网络路径合法性校验：提前检查目录是否可访问，避免因网络故障、权限不足导致的运行时错误。
• 数组扩容逻辑优化：修复原代码可能存在的数组边界问题，通过ReDim Preserve动态扩展数组容量，确保所有符合条件的文件路径都能被正确保存。
• 文件匹配逻辑精准化：通过提取扩展名匹配FileSpec（比如传入*.csv时，精准匹配.csv后缀），避免模糊匹配带来的误差。
• 变量名修正：修正了原代码中循环变量oFi的笔误，避免变量未定义的运行时错误。

使用示例 #

你可以这样调用函数来导入网络驱动器上的目标CSV文件：

Sub ImportNetworkCSV()
    Dim targetDir As String
    Dim csvFiles() As String
    Dim i As Long
    
    ' 替换为你的网络驱动器实际路径（示例：\\file-server\data\csv-archives）
    targetDir = "\\your-network-server\shared-folder\csv-directory"
    ' 获取2024年1月1日之后修改的CSV文件
    csvFiles = FilesAfterDate(targetDir, "*.csv", DateSerial(2024, 1, 1))
    
    ' 遍历筛选出的文件并执行导入逻辑
    For i = LBound(csvFiles) To UBound(csvFiles)
        ' 这里替换为你的CSV导入代码，比如Workbooks.Open或QueryTables
        Debug.Print "准备导入文件：" & csvFiles(i)
    Next i
End Sub

额外注意事项 #

• 网络权限确认：确保运行VBA的用户对目标网络驱动器拥有读取权限，否则FileSystemObject无法访问文件。
• 日期参数规范：AfterDate请使用VBA原生Date类型，避免传入字符串格式的日期，防止因系统区域设置差异导致的日期解析错误。
• 大目录优化：如果网络目录下文件数量极多，建议添加进度提示或分批处理逻辑，避免程序出现假死现象。

内容的提问来源于stack exchange，提问作者Krzysztof Stelmach