如何在Excel VBA中让用户指定文件夹路径并导入工时表数据？

以下是针对你的需求的具体修改步骤，代码简洁易上手，适配VBA基础有限的情况：

1. 新增文件夹选择函数 #

先添加一个通用函数，让用户可以可视化选择本地或OneDrive同步的文件夹（OneDrive同步后在本地有实体文件夹，直接选择即可）：

Function GetUserSelectedFolder() As String
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fd
        .Title = "请选择工时表所在的本地/OneDrive文件夹"
        .AllowMultiSelect = False
        If .Show = -1 Then
            GetUserSelectedFolder = .SelectedItems(1) & "\" '末尾加反斜杠，避免路径拼接出错
        Else
            GetUserSelectedFolder = "" '用户取消选择时返回空值
        End If
    End With
    
    Set fd = Nothing
End Function

2. 改造原有宏的路径逻辑 #

把你现有refresh、rf01等宏里的固定NAS路径替换成调用上面的函数获取用户选择的路径。以refresh宏为例：

Sub refresh()
    Dim targetPath As String
    '获取用户选择的路径
    targetPath = GetUserSelectedFolder()
    
    '如果用户取消选择，直接终止操作
    If targetPath = "" Then
        MsgBox "未选择文件夹，操作取消", vbExclamation
        Exit Sub
    End If
    
    '--------- 以下替换你原有代码中的固定路径部分 ---------
    '比如原来代码里写死的：
    'Dim sourceFile As String
    'sourceFile = "\\NAS服务器地址\工时表\编号-用户名.xlsx"
    '改成：
    'Dim sourceFile As String
    'sourceFile = targetPath & "编号-用户名.xlsx"
    
    '后续的文件操作（打开、读取数据等）都使用targetPath拼接文件名即可
End Sub

3. 批量导入符合命名规则的文件 #

如果需要批量导入所有「编号-用户名.xlsx」格式的文件，用Dir函数筛选匹配规则的文件，示例代码如下：

Sub ImportAllTimesheets()
    Dim targetPath As String
    Dim currentFile As String
    
    targetPath = GetUserSelectedFolder()
    If targetPath = "" Then Exit Sub
    
    '用通配符筛选「*-*.xlsx」格式的文件（匹配任意"编号-用户名"组合）
    currentFile = Dir(targetPath & "*-*.xlsx")
    
    Do While currentFile <> ""
        '打开目标文件（替换成你原有导入单个文件的逻辑）
        Dim sourceWB As Workbook
        Set sourceWB = Workbooks.Open(targetPath & currentFile)
        
        '示例：将源文件Sheet1的A2:E区域数据复制到当前工作簿的"工时汇总"表末尾
        Dim lastRow As Long
        lastRow = ThisWorkbook.Sheets("工时汇总").Cells(Rows.Count, 1).End(xlUp).Row + 1
        sourceWB.Sheets("Sheet1").Range("A2:E" & sourceWB.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row).Copy _
            ThisWorkbook.Sheets("工时汇总").Cells(lastRow, 1)
        
        '关闭源文件，不保存更改
        sourceWB.Close SaveChanges:=False
        '获取下一个符合规则的文件
        currentFile = Dir
    Loop
    
    MsgBox "所有符合规则的工时表已导入完成", vbInformation
End Sub

关键注意事项 #

• 修改完成后，务必将工作簿保存为*.xlsm格式，否则宏会被禁用
• OneDrive同步文件夹在本地有对应路径（比如C:\Users\你的用户名\OneDrive\项目工时表），直接选择这个本地路径即可，无需使用网页端地址
• 如果原有宏里有文件存在性判断、错误处理逻辑，记得同步更新路径变量，避免报错

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