VBA将Excel数据导入MS Access前对各列进行格式化的方法咨询

DoCmd.TransferSpreadsheet 本身没有提供导入前置列格式化的接口，它会自动根据Excel前几行的内容推断数据类型，很容易出现类型不匹配、长度截断的问题，你可以通过以下两种方案实现需求：

方案1：临时表中转清洗（开发成本最低，适合规则简单的场景） #

无需改动原有导入逻辑的核心框架，通过中间层做数据转换即可：

• 第一步：提前创建结构完全匹配需求的正式表，字段类型、长度严格按要求设置：比如A列对应字段设为DateTime类型，B列设为Integer，C列设为Char(25)，D列设为VARCHAR(255)
• 第二步：每次导入先把Excel数据写入临时表（无需提前建表，TransferSpreadsheet导入不存在的表时会自动创建）
• 第三步：通过SQL对临时表的每一列做格式化转换，校验完成后插入正式表，最后清理临时表即可

对应代码示例：

Do While Len(strFile) > 0
    strPathFile = strPath & strFile
    ' 先导入到临时表
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    "tmp_ImportTemp", strPathFile, blnHasFieldNames
    
    ' 格式化后插入正式表，列名替换为你实际的字段名即可
    Dim strSQL As String
    strSQL = "INSERT INTO " & strTable & " (日期字段, 整数字段, 固定长度字段, 变长字段) " & _
             "SELECT CDate(Format(A列字段,'yyyy-mm-dd hh:mm:ss')), CInt(B列字段), Left(C列字段,25), Left(D列字段,255) " & _
             "FROM tmp_ImportTemp"
    CurrentDb.Execute strSQL, dbFailOnError
    
    ' 清理临时表
    DoCmd.DeleteObject acTable, "tmp_ImportTemp"
    strFile = Dir()
Loop

如果需要过滤非法值，可以在SQL中加入IsDate()、IsNumeric()这类判断函数，跳过或者标记异常行。

方案2：调用Excel对象逐行读取校验（灵活度最高，适合复杂格式化规则） #

如果需要做正则替换、字典关联校验这类复杂处理，可以直接打开Excel文件读取单元格内容，处理完成后直接写入正式表，不需要中转：

' 可以提前引用Microsoft Excel xx.x Object Library，也可以直接用晚绑定无需引用
Dim excelApp As Object, excelWb As Object, excelWs As Object
Dim i As Long, lastRow As Long
Set excelApp = CreateObject("Excel.Application")
excelApp.Visible = False

Do While Len(strFile) > 0
    strPathFile = strPath & strFile
    Set excelWb = excelApp.Workbooks.Open(strPathFile)
    Set excelWs = excelWb.Sheets(1) ' 取第一个工作表，可按需调整
    lastRow = excelWs.Cells(excelWs.Rows.Count, "A").End(-4162).Row ' -4162对应常量xlUp
    
    ' 有表头则从第2行开始遍历
    For i = IIf(blnHasFieldNames, 2, 1) To lastRow
        Dim strSQL As String
        ' 每一列读取后先做格式化处理再拼接SQL
        strSQL = "INSERT INTO " & strTable & " (日期字段, 整数字段, 固定长度字段, 变长字段) VALUES (" & _
                 "#" & Format(excelWs.Cells(i, 1).Value, "yyyy-mm-dd hh:mm:ss") & "#," & _
                 CInt(Nz(excelWs.Cells(i, 2).Value, 0)) & "," & _
                 "'" & Replace(Left(excelWs.Cells(i, 3).Value, 25), "'", "''") & "'," & _
                 "'" & Replace(Left(excelWs.Cells(i, 4).Value, 255), "'", "''") & "')"
        CurrentDb.Execute strSQL, dbFailOnError
    Next i
    
    excelWb.Close SaveChanges:=False
    strFile = Dir()
Loop
excelApp.Quit
Set excelWs = Nothing
Set excelWb = Nothing
Set excelApp = Nothing

注意字符串内容里的单引号要转义为两个单引号避免SQL报错，读取完成后一定要手动关闭Excel进程，避免后台残留占用文件。

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