Access及VBA：导入Excel时为指定列填充从文件名提取的日期方案咨询

我们采用自动提取文件名日期+手动输入 fallback的方案，无需修改表单界面，仅需调整导入函数逻辑即可实现需求，修改后的代码如下：

调整后的导入函数代码 #

Public Sub ImportExcelSpreadsheet(fileName As String, shortFileName As String)
    Dim strDateStr As String
    Dim reportDate As Date
    Dim updateSql As String
    
On Error GoTo BadFormat
    ' 清空历史导入数据
    DoCmd.RunSQL ("DELETE * FROM tblImport;")
    ' 导入Excel内容
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tblImport", fileName, True, "A1:F4"
    
    ' -------------------新增日期填充逻辑开始-------------------
    ' 提取文件名中的日期：去掉后缀，取最后8位
    strDateStr = Left(shortFileName, Len(shortFileName) - 5) ' 去掉.xlsx后缀
    strDateStr = Right(strDateStr, 8)
    
    ' 校验提取到的内容是否为合法8位数字
    If IsNumeric(strDateStr) And Len(strDateStr) = 8 Then
        ' 转成日期格式
        reportDate = DateSerial(Left(strDateStr, 4), Mid(strDateStr, 5, 2), Right(strDateStr, 2))
    Else
        ' 提取失败，弹出输入框让用户手动输入
        strDateStr = InputBox("无法从文件名提取日期，请输入报表日期（格式：YYYYMMDD）", "手动输入日期")
        ' 校验用户输入
        If Not (IsNumeric(strDateStr) And Len(strDateStr) = 8) Then
            MsgBox "输入的日期格式错误，导入终止"
            Exit Sub
        End If
        reportDate = DateSerial(Left(strDateStr, 4), Mid(strDateStr, 5, 2), Right(strDateStr, 2))
    End If
    
    ' 执行SQL更新日期列，注意替换下面两个参数：
    ' 1. ReportDate 替换为你tblImport中实际的日期字段名
    ' 2. 主键列 替换为tblImport中不会为空的字段名，用来过滤空行
    updateSql = "UPDATE tblImport SET ReportDate = #" & Format(reportDate, "yyyy-mm-dd") & "# WHERE 主键列 IS NOT NULL"
    DoCmd.RunSQL updateSql
    ' -------------------新增日期填充逻辑结束-------------------
    
    MsgBox "导入成功，日期已自动填充!"
    Exit Sub
    
BadFormat:
    MsgBox "你尝试导入的文件不是合法的Excel表格。"
End Sub

注意事项 #

• 无需修改原有表单的浏览、导入按钮代码，仅需替换上述ImportExcelSpreadsheet函数的全部内容即可
• 务必根据你的实际表结构替换代码中的两处占位内容：ReportDate（你的空日期列的列名）、主键列（导入后肯定不会为空的列名，用来跳过空行）
• 如果你的报表后缀是.xls格式，把Left(shortFileName, Len(shortFileName) - 5)改成Left(shortFileName, Len(shortFileName) - 4)即可

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