解析Web表单到数据表中
问题描述:
有没有人想过如何在VBA中编写动态数据解析器来从文本文件捕获数据并将其输入到数据库表(ms访问)?该表格有大约55个字段,所以我宁愿编写一个代码,它能够从文本中获取字段名称,而不是复制一大堆文本。有没有一个聪明的方法来做到这一点,并避免运行第三方应用程序来执行任务?解析Web表单到数据表中
Web表单(从Joomla组件“PERforms”输出)也可以附加一个XML文件,但这对于直接向Access中导入记录似乎不兼容。
数据的格式如下(我不得不为了增加额外的回车为它多行:
字段1显示:测试
字段2:测试2
字段3:这是地址
这是在窗体上一个textarea
Field4:Field4
我很好地获取数据的某处Access可以从中提取它,它只是解析它导致我的问题。
一如既往,您的帮助是最受赞赏的。
编辑的要求:
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: [email protected]
Most Recent or Current Employer: Employer.Blah
答
你有没有考虑FileSystemObject对象和文本流?它需要一点编码,但不是那么多。
访问可以导入HTML表格,如果这是一个选项。
编辑参考意见。
请注意,这是一个粗略的轮廓,我没有考虑到最后一个字段不止一行。
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
您能解释:在一行的开头是一个字段名吗?如果是这样,那么很容易解析为文本。如果不是这样(即,如果某些数据看起来像:在行首),那么XML选项可能更好 –
barrowc
2009-02-12 19:24:09
您可以复制/粘贴返回的实际数据的样本吗? 将其格式设置为“代码示例”以正确显示它。 – 2009-02-16 10:11:16