Access and VBA: 在导入过程中将日期添加到一列的所有值

Question

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

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

我现在在“tblImport”中有一个空列，我想在其中为非空的每一行添加报告日期。空列已定义为日期列。日期位于文件名“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
´´´

Answer 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

Access and VBA: 在导入过程中将日期添加到一列的所有值

Access and VBA: Add date to all values of one column during import

import

excel

ms-access

vba