使用"导入"按钮访问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名称。