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

时间:2018-03-09 18:23:26

标签: access-vba ms-office

我正在编写一个脚本,该脚本将从遗留系统生成的文本报告中获取数据,并将其导入更灵活的跟踪数据库。我正在试图弄清楚如何从表中的数据构建字典,以便我可以使用字典存在方法快速过滤导入的数据,并仅导入属于我的商店的数据。

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

如何从表中构建字典?

对于好奇,这是我的代码:

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 个答案:

答案 0 :(得分:0)

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

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

在抓取粘贴的文本数据之前插入它,取消注释底部的验证if块,然后它就能正常工作。