【问题标题】:Importing text files - Vb/Access导入文本文件 - Vb/Access
【发布时间】:2016-12-28 21:14:47
【问题描述】:

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

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

这是一个文本文件的示例:

【问题讨论】:

  • 您的模块和表单是否在单独的文件中?如果没有,您的公共函数应该在表单中可见,您只需按其名称调用它。如果它们在单独的文件中,您可以在表单文件中引用包含模块的文件,然后使用函数。
  • 您可以添加您尝试导入的示例文本文件吗?我看不出你在哪里使用函数'ImportFile',我也看不出你为什么有函数而不是 subs。 (函数应该返回一个值,例如 True 如果完成)。这些模块在哪里?
  • @Velid 我已经添加了完整的代码。我将很快提供一个文本文件的示例。我不是要解压缩文件,只是从本地网络上的路径中获取文本文件并将它们导入我的数据库。
  • 你还在吗?
  • 好的。如果您能告诉我们哪里问题出在哪里,我们可能会提供帮助。这个值得一读:Debugging VBA Code

标签: vba ms-access multiple-columns


【解决方案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 &amp; 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)

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

使用

DeleteContract contract

Call DeleteContract(contract)

retVal = DeleteContract(contract)

【讨论】:

    【解决方案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

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多