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

问题描述

我正在尝试创建一个带有对话框的表单，以便用户可以提供文件的位置并将其导入数据库。我提供了导入规范以及代码将追加和更新现有表。但是，在我的情况下，我使用的代码仅适用于一个文件（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

解决方法

在执行查询之前，您可以将表名传递给函数，并将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。目标表应该存在才能正常工作。

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