Access 和 VBA：在导入期间将日期添加到一列的所有值

Posted 2023-02-22

【中文标题】Access 和 VBA：在导入期间将日期添加到一列的所有值

【英文标题】：Access and VBA: Add date to all values of one column during import

【发布时间】：2021-10-31 15:20:37

【问题描述】：

我在导入 Excel 文件时向列添加日期时遇到问题。我的设置如下：

我有一个 AccessDB，我想每天在其中导入 Excel 报告。我有一个表单，我可以在其中浏览报告并通过单击第二个按钮将其导入名为“tblImport”的表。这工作得很好。

我现在在“tblImport”中有一个空列，我想在其中为非 Null 的每一行添加报告日期。空列已定义为日期列。日期位于文件名“YYYYMMDD.xlsx”的末尾。 完美的解决方案是直接从文件名中获取日期并将其添加到列中。但是在我必须添加日期的表单中添加输入框或字段也可以。

但是，我找到的每个解决方案都不适用于我的代码。

如果有任何建议，我将不胜感激。

提前致谢！

表单代码如下：

Private Sub btnBrowse_Click()
    Dim diag As Office.FileDialog
    Dim item As Variant
    
    Set diag = Application.FileDialog(msoFileDialogFilePicker)
    diag.AllowMultiSelect = False
    diag.Title = "Please select an Excel Spreadsheet"
    diag.Filters.Clear
    diag.Filters.Add "Excel Spreadsheets", "*.xls, *.xlsx"
    
    If diag.Show Then
        For Each item In diag.SelectedItems
            Me.txtFileName = item
        Next
    End If
    

End Sub

Private Sub btnImportSpreadsheet_Click()
    Dim FSO As New FileSystemObject
    
    If Nz(Me.txtFileName, "") = "" Then
        MsgBox "Please select a file!"
        Exit Sub
    End If
    
    If FSO.FileExists(Me.txtFileName) Then
        ExcelImport.ImportExcelSpreadsheet Me.txtFileName, FSO.GetFileName(Me.txtFileName)
    Else
        MsgBox "File not found!"
    End If
End Sub

导入函数如下：

Public Sub ImportExcelSpreadsheet(fileName As String, tableName As String)

On Error GoTo BadFormat
    DoCmd.RunSQL ("DELETE * FROM tblImport;")
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tblImport", fileName, True, "A1:F4"
    MsgBox "Import successful!"
    Exit Sub
    
BadFormat:
    MsgBox "The file you tried to import was not an Excel spreadsheet."

End Sub
´´´

【参考方案1】：

您需要编写一个函数来获取日期。这是基于日期在上述格式中的相同位置。您可以详细说明此代码，最好在日期转换功能中添加一些错误检查。现在还早，所以还没有完全测试:)

Public Sub ImportExcelSpreadsheet(fileName As String, tableName As String)

On Error GoTo BadFormat
    docmd.runsql ("DELETE * FROM tblImport;")
    docmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tblImport", fileName, True, "A1:F4"
    '   ***
    docmd.runsql ("Update tblImport set DateImported='" & GetDateFromFileName(fileName) & "'")
    '   ***
    MsgBox "Import successful!"
    Exit Sub
    
BadFormat:
    MsgBox "The file you tried to import was not an Excel spreadsheet."

End Sub

和

Function GetDateFromFileName(strInputFileName As String) As Date

Dim strDatePart As String
Dim intFinalDot As Integer

intFinalDot = InStrRev(strInputFileName, ".")
strDatePart = Mid(strInputFileName, intFinalDot - 8, 8)

GetDateFromFileName = DateSerial(Mid(strDatePart, 1, 4), Mid(strDatePart, 5, 2), Mid(strDatePart, 7, 2))

End Function