导入文本文件 - Vb/Access

Question

我想要做的是映射我的按钮(我的表单上的导入按钮)导入文本文件(文本文件实际上将在网络驱动器上).这些文本文件是固定列.我对如何合并表单和模块以协同工作感到困惑.如何在表单上的按钮,调用此模块执行？此外,如果有一种更有效的方式来导入这些固定的文本文件,我将不胜感激.

我目前为我的表单设置了以下VBA代码(将用于将文本文件导入我的Access数据库):

Private Sub cmdImport_Click()

On Error GoTo Click_Err

    reportDate = Format(txtReportDate, "YYMMDD")
    reportGenDate = Format(textReportDate, "YYYYMMDD")
    rDate = txtReportDate

    If Nz(txtReportDate, "") = "" Then
        MsgBox "NOTICE! Please enter the Report Month you wish to Import."
        Exit Sub
    End If

    DoCmd.Hourglass True
    DoCmd.SetWarnings False

    ImportAll

    DoCmd.Hourglass False
    DoCmd.SetWarnings True
    MsgBox "Finished Importing!"
    DoCmd.OpenQuery "query_Files_Loaded_CE", acViewNormal, acReadOnly

click_Exit:
    DoCmd.Hourglass False
    DoCmd.SetWarnings True
    Exit Sub

Click_Err:
    DoCmd.Hourglass False
    MsgBox "Error Detected: " & Err.Number & " - " & Err.Description, vbCritical, "Error"
    Resume click_Exit
End Sub

对于我的模块(请原谅说明):

    Option Compare Database
Public reportDate As String
Public reportGenDate As String
Public rDate As Date

    Public Function Import2010()
    'Used to import a date range
    Dim funcDate As Date '
    funcDate = #2/1/2016#
    reportDate = Format(funcDate, "YYMM")
    rDate = funcDate

    'Basically Do While is a loop so what your doing here as long as the value of the date does not EQUAL 3/1/2016
    'excute the nexxt line of code other wise exit this loop
    Do While funcDate <> #3/1/2016#
        DoCmd.SetWarnings False
        'ImportAll
        ImportFile "H3561"
        'Msg Box reportDate
        funcDate = DateAdd("m", 1, funcDate)
        reportDate = Format(funcDate, "YYMM")
        rDate = funcDate
    Loop

    DoCmd.SetWarnings True

End Function

Public Function ImportAll() ' Import button on FrmIMport

    'A recordset is a selection of records from a table or query.
    'Dim is short for the word Dimension and it allows you to declare variable names and their type.
    'When you read data from the database in VBA, the result will be in a recordset (with the exception of scalar data).
    Dim rs As Recordset
    Dim sql As String

    'This code loops through the recordset of all contracts and import files, as in it looks for
    'Specific value based off a specific condition.

    sql = "SELECT DISTINCT Contract FROM Contract_CE"
    Set rs = CurrentDb.OpenRecordset(sql)
    rs.MoveLast 'This method is used to move to the last record in a Recordset object. It also makes the last record the current record.
    rs.MoveFirst 'This method is used to move to the first record in a Recordset object. It also makes the first record the current record.
    If rs.RecordCount > 0 Then
        Do While rs.EOF = False
            ImportFile rs!contract
            rs.MoveNext 'This method is used to move to the next record in a Recordset object. It also makes the "next" record the current record.
        Loop
    End If

End Function

Public Function ImportFile(contract As String)

    Dim filepath As String
    Dim tempPath As String
    Dim zipFile As String

    'Set paths
    filepath = "\\XXXXX\XXXXX\XXXXX\XXXXXXX"
   'tempPath = 
    tempPath = "\\XXXXXX\XXXXX\XXXXX\XX"

    'Find the file
    zipFile = GetFile(filepath)

    'check if file exists
    If zipFile = "" Then
        'DoCmd.Hourglass False
        'MsgBox contract & " " & reportDate & " File could not be located."
        'DoCmd.Hourglass True
        LogFail (contract)
        Exit Function
    End If

    'Clearing out existing Contract/ReportDate data from Table
    DeleteContract (contract)

    'Delete all files in temp folder
    DeleteAllFiles (tempPath)

    'UnzipFile txt to temp folder
    UnZip filepath & zipFile, tempPath

    'Get txt file namee
    txtFile = Replace(zipFile, ".zip", ".txt")

    DoEvents
    Sleep 10000 'wait for file to unzip

    'The TransferText method is used to import/export text between the current Access database or Access project and a text file located
    'externally to your database. You can also use this command to link to data in a text file. Additionally, can import from, export to, and link to a table in an HTML file.
    'Importing txt file
    'Depcreated - Alec Johnson - 5/12/2016 - Created new import spec
    'DoCMD.TransferText acImportFixed, "ImportSpec_COMPRPT", tempPath & txtfile, False
    DoCmd.TransferText acImportFixed, "COMPRPT_2016", "COMPRPT_CE", filepath & txtFile, False  '<--does path go here?

    'Update FileName
    UpdateFileName (zipFile)

    'Delete txt file from location
    DeleteAllFiles (tempPath)

    'Delete any Null records added to main table
    DeleteNulls

    'Log to table if successful
    LogSuccess (contract)

End Function

Public Function DeleteAllFiles(path As String)

'Delete all files in this folder
On Error Resume Next
Kill path & "*.*"
End Function

Function UnZip(filename As String, destinationPath As String)
'FileSystemObject also called as FSO, provides an easy object based model to access computer’s file system.
'You simply have to create an instance of FileSystemObject in VBA and then you can generate files, read files, delete files,
'iterate though folders and do many other operations on your computer’s file system.


    'Unzip file (s) to destination
    Dim app As Object
    Dim zipFile As Variant, unzipTo As Variant

    zipFile = filename
    unzipTo = destinationPath

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If Not FSO.FolderExists(unzipTo) Then
        FSO.CreateFolder (unzipTo)
    End If

    'If you want to extract only file you can use this:
    'oApp.Namespace(FileNameFolder).CopyHere _
    'oApp.Namespace(Fname).items.items("test.txt")

    Set oApp = CreateObject("Shell.Application")

    oApp.Namespace(unzipTo).CopyHere oApp.Namespace(zipFile).Items

    Set FSO = Nothing

End Function

Public Function GetFile(filepath As String) As String

    Dim fileNamePart As String
    Dim fCheck

    fileNamePart = "COMPRPT_" + reportDate
    fCheck = ""
    fFound = ""

    Set oFolder = CreateObject("scripting.filesystemobject").GetFolder(filepath)
    For Each aFile In oFolder.Files
        Set fCheck = aFile
        If InStr(fCheck.Name, fileNamePart) Then
            Set fFound = aFile
            End If
        Next

        If fFound = "" Then
            GetFile = ""
        Else
            GetFile = fFound.Name
        End If

End Function

Public Function DeleteContract(contract As String)

    Dim sql As String
    sql = "Delete * FROM COMPRPT WHERE ContractNumber = '" & contract & "' AND ReportGenerationDate = '" & reportGenDate & "'"
    DoCmd.RunSQL sql
End Function

Public Function LogSuccess(contract As String)

    Dim sql As String
    sql = "INSERT INTO FilesLoaded (Contract, ReportDate, Loaded) VALUES ('" & contract & "', #" & rDate & "#, -1)"
    DoCmd.RunSQL sql

End Function


Public Function DeleteNulls()

    Dim sql As String
    sql = "DELETE * FROM COMPRPT WHERE ContractNumber Is Null"
    DoCmd.RunSQL sql


End Function

Public Function lksjdlaskjd()

    ImportFile "H0351", #4/1/2009#
End Function

以下是文本文件的示例:

Answer 1

如果我理解正确的话，你的问题就在这里：

DoCmd.TransferText acImportFixed, "COMPRPT_2016", "COMPRPT_CE", filepath & txtFile, False  '<--does path go here?

但你已经解压到tempPath，所以应该是

DoCmd.TransferText acImportFixed, "COMPRPT_2016", "COMPRPT_CE", tempPath & txtFile, False

使用网络文件通常比使用本地文件慢，所以我会创建tempPath一个本地路径。

编辑：请注意，要tempPath & txtFile工作，必须以:tempPath结尾\
tempPath = "C:\XXXXXX\XXXXX\XXXXX\XX\"

您的代码的其他问题：

1 - 首先也是最重要的，使用Option Explicit，有关详细信息，请参阅此问题。

您有多个未声明或拼写错误的变量，例如fFound, 和oAppvs. app。

2 - 这是一个即将发生的错误：

reportDate = Format(txtReportDate, "YYMMDD")
reportGenDate = Format(textReportDate, "YYYYMMDD")

将第二个文本框命名为txtReportGenDate，而不是textReportDate。

3 - 在 中ImportAll()，所有这些都不需要，因为您不使用 RecordCount：

rs.MoveLast 
rs.MoveFirst 
If rs.RecordCount > 0 Then

4 - 这是错误的语法：

DeleteContract (contract)

它适用于单个参数，但对于具有 >1 个参数的 subs 会失败。

使用

DeleteContract contract

或者

Call DeleteContract(contract)

或者

retVal = DeleteContract(contract)