Microsoft Access模块上传txt文件，然后导入到表中

Question

我是Access的新手，已经尝试了30多天了。im正在创建一个模块或任何东西，当按下窗体中的按钮时，模块将显示一个文件对话框。获取.txt文件并将其插入到表中

这是我得到的距离

Private Sub FileUpload()
'Requires reference to Microsoft Office 12.0 Object Library.
   Dim fDialog As Office.FileDialog
   Dim varFile As Variant
   Const MyFile = "TXT_Import_Spec" 'change to suit

   'Clear listbox contents.
   'Me.FileList.RowSource = ""
   'Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      'Allow user to make multiple selections in dialog box.
       .AllowMultiSelect = False
       'Set the title of the dialog box.
       .Title = "Please choose FM16 text files"
  'Clear out the current filters, and add our own.
  .Filters.Clear
  .Filters.Add ".txt FM16 Files", "*.TXT"
  .Show
obJaces
      'Import Myfile
    DoCmd.TransferText acImportDelim, "TXT_Import_Spec", "DM1", "MyFile", False
'Delete old records from Tbl_Import
'CurrentDb.Execute "DELETE * FROM DM1"
'Add new records to Tbl_Import
CurrentDb.Execute "INSERT INTO DM1 SELECT * FROM MyFile WHERE MyFile.JobNo IN (SELECT MyFile.JobNo FROM MyFile LEFT JOIN Tbl_Import ON MyFile.JobNo = Tbl_Import.JobNo WHERE Tbl_Import.JobNo Is Null)"
'Delete Myfile Table
CurrentDb.Execute "DROP TABLE MyFile"

End With
End Sub

整整一周都很紧张。将感谢任何帮助。

Answer 1

@DonGeorge我已经设法让脚本工作了，请检查下面的脚本，但问题是它永远都会被占用。因为txt文件有大约900000条记录。

因此，为了避免溢出错误，我所做的是在上传的每100000条记录中显示通知的脚本。但一台好电脑需要5分钟。

Option Compare Database

Sub uploadData()
On Error GoTo 11:
Dim strFile As String

Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim cnt As Double
strFile = GetFile
If strFile <> "" Then
    Set db = CurrentDb()
    Set rs1 = db.OpenRecordset("BM1")
    Dim firstLine As Boolean
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile(strFile)
    firstLine = False
    msg = MsgBox("Do you want to delete all records from BM1 before loading ?", vbCritical + vbYesNo, "Upload File")
    If msg = vbYes Then
        DoCmd.SetWarnings False
        DoCmd.RunSQL "delete * from BM1"
        DoCmd.SetWarnings True
    End If
    Do Until objFile.AtEndOfStream
    strEmployee = objFile.ReadLine
        If firstLine = True Then
            arrEmployee = Split(strEmployee, ",")
            If UBound(arrEmployee) = 20 Then
                rs1.AddNew
                For i = 0 To rs1.Fields.Count - 1
                    rs1.Fields(i).Value = Replace(arrEmployee(i), """", "")
                Next
                rs1.Update
            End If
        Else
            firstLine = True
        End If
        cnt = cnt + 1
        If cnt Mod 100000 = 0 Then
            MsgBox "Records Added " & cnt
        End If
    Loop
    rs1.Close
    MsgBox "Records Upload Completed"
End If
Exit Sub
11:
MsgBox Err.Description
End Sub
Function GetFile() As String
 Dim f    As Object
 Set f = Application.FileDialog(3)
 Dim varfile As Variant
 f.AllowMultiSelect = False
 f.Filters.Clear
 f.Filters.Add "Text File", "*.txt"
 f.Show

 For Each varfile In f.selecteditems
    GetFile = varfile
    Exit For
 Next varfile
End Function