代码之家 › 专栏 › 技术社区 › Chaosbydesign

如何从特定的表字段创建字典?

ms-office vba ms-access

Chaosbydesign · 技术社区 · 6 年前

我正在编写一个脚本,它将从遗留系统生成的文本报告中获取数据,并将其导入到更灵活的跟踪数据库中。我试图找出如何从表中的数据构建字典,以便使用dictionary exists方法快速筛选导入的数据,并仅导入属于我的店铺的数据。

我有一张桌子叫 tblShop 包含名为 [WorkcenterID] 。当我的脚本运行时,它将从文本报告中提取数据,查看员工的工作中心,检查该员工是否属于我(通过将提取的工作中心文本与字典进行比较),如果为真,则将数据写入导入表以供进一步处理。

如何从表中构建词典?

出于好奇,以下是我的代码:

Private Sub Command5_Click()

Dim crscd, startdt, stopdt, starttm, stoptm, bldstr, rmstr, evtid, empn, empw As String
Dim i, cd, ci, es, ee As Integer
Dim cdb As DAO.Database
Dim imt, sht As DAO.Recordset
Dim wcDict As New Scripting.Dictionary

Set cdb = CurrentDb
Set imt = cdb.OpenRecordset("tblImport", dbOpenTable)
Set sht = cdb.OpenRecordset("tblShop", dbOpenTable)
'--- grab pasted text data from form ---
strText = Me.InData.Value
'--- split text data into array so we can read line by line ---
arrlines = Split(strText, vbCrLf)
'--- reset line counters ---
i = 0
ci = -1
cd = -1
es = -1
ee = -1

For Each strline In arrlines
    '--- find location of course info ---
    If Left(strline, 17) = "COURSE  NARRATIVE" Then
        cd = i + 2
    End If
    '--- find location of course location info & event ID
    If Left(strline, 8) = "BUILDING" Then
        ci = i + 1
    End If
    '--- find where assigned employee data starts
    If Left(strline, 6) = "EMP NR" Then
        es = i + 1
    End If
    '--- find where assigned employee data ends
    If es > 0 And IsNumeric(Left(strline, 5)) = False Then
        ee = i - 1
    End If
    '--- extract course code and start/stop dates/times
    If i = cd Then
        crscd = Left(strline, 6)
        startdt = Left(Right(strline, 28), 7)
        starttm = Left(Right(strline, 20), 4)
        stopdt = Left(Right(strline, 15), 7)
        stoptm = Left(Right(strline, 7), 4)
    End If
    '--- extract building number, room number and event ID
    If i = ci Then
        bldstr = Trim(Left(strline, 13))
        rmstr = Trim(Left(Right(strline, 55), 9))
        evtid = Trim(Left(Right(strline, 46), 9))
    End If
i = i + 1
Next
'--- clear import table
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tblImport"
DoCmd.SetWarnings True
'--- dump employee data to import table
For n = es To ee
    empn = Left(Left(arrlines(n), 48), 5)
    empw = Left(Right(Left(arrlines(n), 48), 11), 4)
    '--- verfiy employee belongs to us before importing data
    'If wcDict.exists(empw) = True Then
        'imt.AddNew
        'imt!EmpID = empn
        'imt!Workcenter = empw
        'imt.Update
    'End If
Next

wcDict = Nothing
imt.Close
Set imt = Nothing
sht.Close
Set sht = Nothing
cdb.Close
Set cdb = Nothing
End Sub

1 回复 | 直到 4 年前

Chaosbydesign 6 年前

解决方案是使用以下代码循环遍历记录集以提取所需的数据:

sht.MoveFirst
Do While Not sht.EOF
    empw = sht![WorkcenterID]
    wcDict.Add empw, vbNullString
    sht.MoveNext
Loop
empw = ""

在粘贴的文本数据抓取之前插入,取消对verify的注释 if 在底部堵住,它就会起作用。