导入文本文件 - Vb / Access

时间:2016-12-28 21:14:48

标签: vba ms-access multiple-columns

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

我目前为我的表单设置了以下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

以下是文本文件的示例:

enter image description here

2 个答案:

答案 0 :(得分:4)

如果我理解正确,你的问题就在于:

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,有关详细信息,请参阅this question

您有多个未声明或拼写错误的变量,例如fFoundoAppapp

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)

它适用于单个参数,但对于带有&gt; 1个参数的潜艇将失败。

使用

DeleteContract contract

Call DeleteContract(contract)

retVal = DeleteContract(contract)

答案 1 :(得分:2)

  

我对如何合并表单和模块以协同工作感到困惑。表单上的按钮如何调用此模块执行?

对象和程序可以被视为公共或私人。例如: -

Private Sub Test
    Msgbox "Hello World!"
End Sub

是私有的,这意味着只有它的父母可以调用它。为了详细说明这一点,让我们创建两个模块Module1Module2,并将private sub Test放在Module1中。

同样在Module1我们另一个私人程序: -

Private Sub Test2
    Msgbox "Back at ya"
End Sub

Module1TestTest2的父级,因为他们拥有相同的父级,可以互相运行: -

Private Sub Test
    Msgbox "Hello World!"
    Test2 'This will run the Test2 procedure
End Sub

Module2无法运行其中任何一个,因为它没有查看它们,它没有参与。

现在,如果我们将Test更改为公开(Public Sub Test),Module2将能够看到它已曝光。

Module2我们有: -

Public Sub Test3
    Module1.Test    'This will run as it is public
    Module1.Test2   'This will fail as it is private
End Sub

也有这种方式从第二单元中调用它们: -

Public Sub Test3
    Test    'This will run as it is public
    Test2   'This will fail as it is private
End Sub

虽然这不明确并且可能导致错误和混淆,您可以在Module2中创建一个也称为Test的过程,您如何知道哪个测试Test3正在运行?为了安全起见,您明确将其位置写为Module1.Test