Question

我是Access的新手，现在已经尝试过3天了。 im tyingin创建一个模块或任何当按下表单中的按钮时模块将显示文件对话框。获取.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文件有900,000条记录。

所以我为避免溢出错误所做的是在每上传100,000条记录中显示通知的脚本。但这对于一台好电脑来说需要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

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

1 个答案: