将Web表单解析为数据表

has anyone an idea of how to write a dynamic data parser in VBA to capture data from a text file and input it in to a database table (ms access)? The form has about 55 fields, so I'd rather write a code that is capable of picking up the field name from the text than copying a load of text. Is there a smart way to do this and avoid running a third party app to carry out the task?

有没有人知道如何在VBA中编写动态数据解析器以从文本文件中捕获数据并将其输入到数据库表(ms访问)?表单有大约55个字段,所以我宁愿编写一个能够从文本中获取字段名称而不是复制大量文本的代码。有没有一种聪明的方法来做到这一点,并避免运行第三方应用程序来执行任务?

The web form (which is output from the Joomla component "PERforms") can also attach an XML file, but this doesn't seem compatible for a straightforward record import in to Access.

Web表单(从Joomla组件“PERforms”输出)也可以附加XML文件,但这似乎不能兼容到Access中的简单记录导入。

The format of the data is as below (I've had to add extra carriage returns in order for it to display across multiple lines.:

数据格式如下(我必须添加额外的回车才能显示多行:

Field1 : Test

Field1:测试

Field2 : Test 2

Field2:测试2

Field3 : This is the address

Field3:这是地址

Which is a textarea

这是一个textarea

on the form

在表格上

Field4 : Field4

Field4:Field4

I'm fine getting the data somewhere Access can pick it up from, it's only parsing it that's causing me the problem.

我很好地将数据传送到某处Access可以从中获取,它只是解析它导致我的问题。

As always, your help is most appreciated.

一如既往,非常感谢您的帮助。

EDit, as requested :

根据要求编辑:

Role Applied For: Door Supervisor
Title: Mr

Full Name: John Smith



SIA DL Badge Number: 01300114000000000







Home Address: Catford Road,Bellingham
London

Home Postcode: SE1 1SE

Nationality: Nigerian

I certify that I am entitled to work within the United Kingdom: Yes

Term Time Address: Sheep St, Bellingham
London

Term Time Postcode: se1 1se



Evening Phone Number: 07222284806

Mobile Number: 07922226206

Email Address: yxs@yahoo.co.uk

Most Recent or Current Employer: Employer.Blah

1 个解决方案

#1

Have you considered the FileSystemObject and textstream? It woulod take a little coding, but not that much.

你考虑过FileSystemObject和textstream吗?它需要一些编码,但不是那么多。

Access can import HTML tables, if that is an option.

Access可以导入HTML表,如果这是一个选项。

EDIT with reference to comments.

编辑参考评论。

Note that this is a rough outline and I have not made allowances for the last field being more than one line.

请注意,这是一个粗略的轮廓,我没有考虑最后一个字段是多行。

Sub BuildTable()
'Reference Windows Scripting Host Object Model '
Dim fs As FileSystemObject
Dim f As TextStream
Dim strfile
Dim a, fld, fldlist, strSQL

Set fs = CreateObject("Scripting.FileSystemObject")

strfile = "C:\Docs\TestData.txt"
Set f = fs.OpenTextFile(strfile)

Do While AtEndOfStream <> True
    If f.AtEndOfStream Then Exit Do

    a = f.ReadLine

    'Assumes all lines with colons have a field '
    ' at the start '
    If InStr(a, ":") > 0 Then
        fld = Left(a, InStr(a, ":") - 1)
        fldlist = fldlist & ",[" & fld & "] Text(250)"
    End If
Loop

'Run once'
strSQL = "CREATE TABLE ImportData (" & Mid(fldlist, 2) & ")"

CurrentDb.Execute strSQL
End Sub

Sub FillTable()
'Reference Windows Scripting Host Object Model '
Dim fs As FileSystemObject
Dim f As TextStream
Dim rs As DAO.Recordset
Dim strfile
Dim a, fld, dat, lastfield 

Set rs = CurrentDb.OpenRecordset("ImportData")
lastfield = rs.Fields(rs.Fields.Count - 1).Name

Set fs = CreateObject("Scripting.FileSystemObject")

strfile = "C:\Docs\TestData.txt"
Set f = fs.OpenTextFile(strfile)

rs.AddNew
Do While AtEndOfStream <> True
    If f.AtEndOfStream Then Exit Sub

    a = f.ReadLine

    If InStr(a, ":") > 0 Then
        'field and data, assumes all lines with '
        'a colon have a field '
        'If you have tidied the table, now is a '
        'good time to check that this is a field '
        If fld <> "" Then
            rs(fld) = dat

            fld = ""
            dat = ""

        End If

        fld = Left(a, InStr(a, ":") - 1)
        dat = Mid(a, InStr(a, ":") + 1)
    Else
        If Trim(a) <> "" Then
            dat = dat & a
        End If
    End If

    If InStr(a, lastfield) > 0 Then
        rs(fld) = dat

        fld = ""
        dat = ""

        rs.Update
        rs.AddNew
    End If

Loop
End Sub

#1