new ms access VBA script > help wanted

[RiverMersey]

help wanted

Could someone verify my attempt at generating pluscodes in msaccess, please?

Seems to work for the first most significant 10 pluscode characters but, tbh, I couldn't understand the verbal description of the process for the least significant part.

My code runs very quickly, a uk database table of about 1.77m records can be processed in about 90 seconds. (Although, I did cheat a little as I wrote a version that reads and writes disk CSV files due to my MS access crashing when running this on tables directly!) Version below has been run against tables of around 80k records without failing.

Many thanks for your advice and help.

---

vvvvvvvvvvvvvvv Code starts below vvvvvvvvvvvvvvvvvvvvvvv

---

Sub pluscode() Dim dbs As DAO.Database Dim t As DAO.TableDef Dim f As DAO.Field

Dim rsTable As DAO.Recordset
Dim rsQuery As DAO.Recordset

Set dbs = CurrentDb


pcTable = InputBox("Open table", "Open table", "Us-zip-code-latitude-and-longitude")


Set rsTable = dbs.OpenRecordset(pcTable, dbOpenTable)
Set tdTable = dbs.TableDefs(pcTable)

If Not FindColumn(pcTable, "Longitude") Then
    MsgBox ("Table: " & pcTable & " doesn't have Longitude field... exiting...")
    Exit Sub
    End If
If Not FindColumn(pcTable, "Latitude") Then
    MsgBox ("Table: " & pcTable & " doesn't have Latitude field... exiting...")
    Exit Sub
    End If
If FindColumn(pcTable, "pluscode") Then
    MsgBox ("Table: " & pcTable & " DOES have pluscode field... exiting...")
    Exit Sub
    End If

rsTable.Close
Set fldNew = tdTable.CreateField("pluscode", dbText, 20)
tdTable.Fields.Append fldNew


Set rsTable = dbs.OpenRecordset(pcTable, dbOpenTable)
rsTable.MoveFirst

pcstring = "23456789CfGHJMPQRVWX"

While Not rsTable.EOF
    longi = Int((rsTable!longitude.Value + 180) * 8000)
    Lati = Int((rsTable!latitude.Value + 90) * 8000)
    Str_Out = ""

    For x = 1 To 5
        Str_Out = Mid(pcstring, Int(longi Mod 20) + 1, 1) & Str_Out
        Str_Out = Mid(pcstring, Int(Lati Mod 20) + 1, 1) & Str_Out
        longi = Int(longi / 20)
        Lati = Int(Lati / 20)
        Next x

'Least significant code generator goes here rsTable.Edit rsTable!pluscode.Value = Mid(Str_Out, 1, 8) & "+" & Mid(Str_Out, 9, 2) rsTable.Update rsTable.MoveNext Wend

rsTable.Close

End Sub

Function FindColumn(strTableName, strColumnName) As Boolean

Dim dbs As Database
Dim fld As DAO.Field

Set dbs = CurrentDb

On Error Resume Next
Set fld = dbs.TableDefs(strTableName).Fields(strColumnName)

If Err = 0 Then FindColumn = True

Set fld = Nothing
Set dbs = Nothing

End Function

[fulldecent]

Recommended tag: implementation request