访问 VBA 以使用导入按钮导入多个 csv 文件

Question

我正在尝试创建一个带有对话框的表单，以便用户提供文件的位置并将其导入数据库。我已经提供了导入规范以及将附加和更新现有表的代码。但是，在我的情况下，我使用的代码仅适用于一个文件 (WM_3M)。我正在寻找将根据用户上传的 CSV 文件更新现有表的代码。例如，如果用户上传了 WM_3M 的文件，则应更新与其关联的表，如果 WM_5M 则更新与其关联的表，依此类推。

对话框代码：

Option Compare Database
Option Explicit
Public Sub ImportFile()
    Const FORM_NAME As String = "ImportFile"
    DoCmd.OpenForm FORM_NAME, , , , , acDialog
    If formIsOpen(FORM_NAME) Then
       ImportCSVFiles Forms(FORM_NAME).fileName
        DoCmd.Close acForm, FORM_NAME, acSaveNo
    MsgBox "Import Completed"
    End If
End Sub
Public Function formIsOpen(ByVal formName As String) As Boolean
    formIsOpen = SysCmd(acSysCmdGetObjectState, acForm, formName)
End Function

Public Sub RunImportProcedure(ByVal fileName As String)
    MsgBox " RunImportProcedure called for file" & fileName
End Sub

导入代码：

Option Compare Database
Option Explicit
Public Sub ImportCSVFile(fileName As String)
    Const TARGET_TABLE As String = "WM_3M_Export_Imported"
    deleteTableIfExists TARGET_TABLE
    DoCmd.TransferText acImportDelim, "WM Import Specification", TARGET_TABLE, _
    fileName, True, , 1252
    
    CurrentDb.Execute "qryWM_3M_Update", dbFailOnError
    CurrentDb.Execute "qryWM_3M_Append", dbFailOnError
End Sub

Public Sub deleteTableIfExists(ByVal tableName As String)
    Dim db As DAO.Database
    Dim td As TableDef
    Set db = CurrentDb
    For Each td In db.TableDefs
        If td.Name = tableName Then
        db.TableDefs.Delete tableName
        Exit For
    End If

表格代码：

Option Compare Database
Option Explicit
Private Sub Cancel_Click()
    DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
Private Sub ImportFile_Click()
 If Len(Me.txtFileName.Value) > 0 Then
        Me.Visible = False
    Else
        MsgBox " Please enter file name"
    End If
End Sub
Public Property Get fileName() As String
    fileName = Nz(Me.txtFileName.Value, "")
End Property


Private Sub Select_Click()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Any file", "*.*", 1
    .Filters.Add "Comma seperated file", "*.csv;*.txt", 2
    .FilterIndex = 2
   
    If .Show Then
        Me.txtFileName.Value = .SelectedItems.Item(1)
    End If
   
End With


End Sub

Answer 1

您可以将表名传递给函数，并在执行查询之前将qryWM_3M_Update和qryWM_3M_Append的QueryDef动态更新到目标表。

Public Sub ImportCSVFile(fileName As String, TARGET_TABLE as String)
    deleteTableIfExists TARGET_TABLE
    DoCmd.TransferText acImportDelim, "WM Import Specification", TARGET_TABLE, _
    fileName, True, , 1252
    
        Dim db As Database
        Set db = CurrentDb

        Dim qdf1 As QueryDef
        Set qdf1 = db.QueryDefs("qry_Update")
        qdf1.SQL = "UPDATE " &  TARGET_TABLE & " SET Field1 = ...."
        qdf1.Close
        Set qdf1 = Nothing
        
        Dim qdf2 As QueryDef
        Set qdf2 = db.QueryDefs("qry_Append")
        qdf2.SQL = "INSERT INTO " & TARGET_TABLE & " SELECT ...."
        qdf2.Close
        Set qdf2 = Nothing

        db.Execute "qry_Update", dbFailOnError
        db.Execute "qry_Append", dbFailOnError
    End Sub

请根据您的结构自行完成SQL定义，但想法是通过字符串连接构建SQL。目标表应该存在才能正常工作。

如果您需要表名的后缀，您可以像 Forms(FORM_NAME).fileName & "_Export_Imported" 这样构建 TARGET_TABLE 名称。