vbacsvms-accessforeachcontrol-characters

Remove All Control Characters In All String Fields In All Tables In Access Database


I need to scrub a regularly received Access database so that all of its tables can be exported to "clean" CSVs and then imported by Base SAS via PROC IMPORT.

I am not experienced with Access VBA or programming in general, but I attempted to kitbash a script to loop through every field in every table and replace certain characters. It doesn't appear to work and I get several "Type Conversion Failure" errors while it's running.

Public Sub ReplaceCharAllTables()

Dim strSQL As String
Dim fld As DAO.Field
Dim db As DAO.Database

Set db = CurrentDb()

Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentData



' Cycle through all tables in database
For Each obj In dbs.AllTables

    ' Cycle through all fields in the table
    For Each fld In db.TableDefs("[" & obj.Name & "]").Fields

        If fld.Type = dbText And Not IsNull(fld) Then

            strSQL = "Update [" & obj.Name & "] Set [" & fld.Name & "]= Replace([" & fld.Name & "],Chr(10),'. ')"
            DoCmd.RunSQL strSQL

            strSQL = "Update [" & obj.Name & "] Set [" & fld.Name & "]= Replace([" & fld.Name & "],Chr(13),'. ')"
            DoCmd.RunSQL strSQL

        End If

    Next

Next obj

End Sub

Note that this particular code current only attempts to remove two characters. It's just a temporary testbed.

EDIT 2016.11.30: Just wanted to say that Andre's solution was perfect. I ended up needing to make a couple minor tweaks, particularly to also look at "memo" fields in addition to text fields and to write the helpful debug info to a text file rather than to the size-limited Immediate Window. Looping through an array of character codes was deceptively clever.

Public Sub ReplaceCharAllTables()

Dim strSQL As String
Dim fld As DAO.Field
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim strFld As String
Dim arCharCodes As Variant
Dim code As Variant
Dim strFolder As String
Dim n As Integer
Dim strUpdate As String

' Get stuff setup save debug.print log file
strFolder = Application.CurrentProject.Path & "\" & Application.CurrentProject.Name & "_RemoveCharLog.txt"
n = FreeFile()
Open strFolder For Output As #n

' all charcodes to replace
arCharCodes = Array(10, 13, 44)

Set db = CurrentDb()

' Cycle through all tables in database
For Each td In db.TableDefs

    ' Ignore system tables
    If Not (td.Name Like "MSys*" Or td.Name Like "USys*") Then

        ' Cycle through all fields in the table
        For Each fld In td.Fields

            If fld.Type = dbText Or fld.Type = dbMemo Then       ' Check if field is text or memo

                ' Cycle through all character codes to remove
                For Each code In arCharCodes

                    strFld = "[" & fld.Name & "]"

                    strSQL = "UPDATE [" & td.Name & "] " & _
                             "SET " & strFld & " = Replace(" & strFld & ", Chr(" & code & "), '. ') " & _
                             "WHERE " & strFld & " LIKE '*" & Chr(code) & "*'"

                    db.Execute strSQL
                    strUpdate = "Updated " & db.RecordsAffected & " records."

                    'Start printing logs
                    Debug.Print strSQL
                    Debug.Print strUpdate

                    Print #n, strSQL
                    Print #n, strUpdate

                Next code

            End If

        Next fld

    End If

Next td

End Sub

Solution

  • In principal there is nothing wrong with your code as far as I can see. The main problem may be that it also attempts to update all system tables - check "System objects" in the Navigation options of the navigation pane to see them.
    They start with MSys or USys.

    A few other things to improve:

    My suggestion:

    Public Sub ReplaceCharAllTables()
    
        Dim strSQL As String
        Dim fld As DAO.Field
        Dim db As DAO.Database
        Dim td As DAO.TableDef
        Dim strFld As String
        Dim arCharCodes As Variant
        Dim code As Variant
    
        ' all charcodes to replace
        arCharCodes = Array(10, 13)
    
        Set db = CurrentDb()
    
        ' Cycle through all tables in database
        For Each td In db.TableDefs
    
            ' Ignore system tables
            If Not (td.Name Like "MSys*" Or td.Name Like "USys*") Then
    
                ' Cycle through all fields in the table
                For Each fld In td.Fields
    
                    If fld.Type = dbText Then
    
                        For Each code In arCharCodes
    
                            strFld = "[" & fld.Name & "]"
    
                            strSQL = "UPDATE [" & td.Name & "] " & _
                                     "SET " & strFld & " = Replace(" & strFld & ", Chr(" & code & "), '. ') " & _
                                     "WHERE " & strFld & " LIKE '*" & Chr(code) & "*'"
                            Debug.Print strSQL
    
                            db.Execute strSQL
                            Debug.Print "Updated " & db.RecordsAffected & " records."
    
                        Next code
    
                    End If
    
                Next fld
            End If
        Next td
    
    End Sub
    

    If this still gives errors, check the specific SQL (Ctrl+g shows the output of Debug.Print) - what column data type does it want to update?