如何使用VBA按预设目录和指定单元格值自动导入Excel工作簿

以下是调整后的完整可运行代码，取消了文件选择弹窗，自动从预设路径读取B1单元格指定的文件：

'import excel data sheet
Sub import()
    Dim fName As String, wb As Workbook, sh As Worksheet
    Dim basePath As String
    
    ' 预设固定读取路径
    basePath = "C:\Jobs\packlist\"
    ' 拼接路径和PL CALC工作表B1的文件名
    fName = basePath & ThisWorkbook.Sheets("PL CALC").Range("B1").Value
    
    ' 校验文件是否存在，不存在直接提示退出
    If Dir(fName) = "" Then
        MsgBox "指定路径下未找到对应文件，请检查B1单元格文件名是否正确", vbExclamation
        Exit Sub
    End If
    
    ' 打开目标文件复制工作表
    Set wb = Workbooks.Open(fName)
    For Each sh In wb.Sheets
        sh.Copy After:=ThisWorkbook.Sheets(18)
        Exit For ' 仅复制第一个工作表，和原逻辑保持一致
    Next
    wb.Close SaveChanges:=False
    ThisWorkbook.Sheets("PL CALC").Activate
End Sub

核心调整说明 #

• 移除了原代码中的Application.GetOpenFilename文件选择弹窗逻辑，固定读取路径为C:\Jobs\packlist\，文件名直接从PL CALC工作表B1单元格读取拼接，不再需要手动选择文件
• 新增文件存在性校验，避免路径或文件名错误时程序直接崩溃
• 补充了工作表变量sh的声明，同时修正了原代码中Sheets.Copy未指定来源的逻辑漏洞，明确复制目标文件内的工作表，避免出现复制错误
• 所有引用当前工作簿的位置都加了ThisWorkbook前缀，避免多个工作簿同时打开时出现读取错误，也删掉了稳定性差的路径切换语句ChDrive、ChDir，直接用全路径读取文件更可靠

注意事项 #

如果PL CALC工作表B1单元格内仅填写文件名不带后缀，可根据你实际导出的文件格式调整文件名拼接规则，比如导出为xlsx格式就将fName赋值语句修改为：
fName = basePath & ThisWorkbook.Sheets("PL CALC").Range("B1").Value & ".xlsx"

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