VBAにてACCESSファイルのテーブル名を取得しデータを編集する方法

テーブルのデータを一括で変更するコードです。
主にお客様にDBの説明をする際に、個人情報や会社情報の一括変更に使います。
テキスト型のデータの変換にのみ対応してます。

以下のコードはCurrentdb(現在ウィンドウで開いているACCESSデータベース)のテーブル名をコンボボックス(テーブル名検索)にリスト表示するものです。

'テーブル名検索コンボボックスのリスト呼び出し
　　Private Sub Form_Load()
　　Dim db As DAO.Database
　　Dim SQL As String

    Set db = CurrentDb

    'コンボボックス”テーブル名検索”リストのソースタイプを指定
    Me.テーブル名検索.RowSourceType = "Table/Query"

    'dbのテーブル名の取得
    SQL = "SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Type = 1 and MSysObjects.Flags =  0 ORDER BY MSysObjects.Name;"

　　'コンボボックス”テーブル名検索”リストのソースを指定
    Me.テーブル名検索.RowSource = SQL

End Sub

Accessのオブジェクト一覧を取得する方法としてMSysObjectsを使用します。

MSysObjects.Name:MSysObjectsテーブルのNameフィールドを指します。このフィールドには、データベース内の各オブジェクト（テーブル、クエリなど）の名前が格納されています。

MSysObjects: Access データベースのシステムテーブルの一つで、データベース内のすべてのオブジェクトに関する詳細な情報を保持しています。

MSysObjects.Type = 1: Type フィールドはオブジェクトの種類を表します。1 はローカルテーブル（通常のユーザーが作成したテーブル）を示します。
これにより現在開いているDBのテーブル情報を、コンボボックスのリスト表示できます。

プルダウンリストにテーブル名が表示されました。

このコードはコンボボックス(テーブル名検索)でテーブル名を選択したときに、コンボボックス(フィールド名検索)にフィールド名のリスト表示をするものです。

'フィールド名検索コンボボックスのリスト呼び出し
Private Sub テーブル名検索_AfterUpdate()

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field

    ' コンボボックスをクリア
    Me.フィールド名検索.RowSource = ""
    Me.フィールド名検索.Requery
    Me.フィールド名検索 = Null

    ' データベースを開く
    Set db = CurrentDb

    ' テーブル定義を取得
    On Error Resume Next
    Set tdf = db.TableDefs(Me.テーブル名検索.Value)
    On Error GoTo 0

    ' テーブルが存在するかチェック
    If tdf Is Nothing Then
        MsgBox "指定したテーブルは存在しません。", vbExclamation
        Exit Sub
    End If

    ' フィールドをコンボボックスに追加
    For Each fld In tdf.Fields
        Me.フィールド名検索.AddItem fld.Name
    Next fld
End Sub

テーブル名のプルダウンリストから[商品]テーブルを選択することで、[商品]テーブルのフィールド名のプルダウンが表示されました。

[商品]テーブルから[商品名]フィールドのデータの変換をします。
左から残す文字数を決めて置換ボタンを押すと変換されます。
画像では2を入力しているので左から２文字目まで残り、以降の文字は****に変更されます。

置き換えボタンのコードです。
※このコードを実行して置き換え処理を実行すると伏字などではなく、データ自体が****に置き換わりますので元の値に戻すことは出来ません。テーブルのコピーなどでバックアップを取ってから実行してください。

Private Sub B_置き換え_Click()

Dim 変換文字列 As String
Dim 変換フィールド名 As String
Dim strText As String
Dim leftPart As String
Dim starPart As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim td As DAO.TableDef
Dim fld As DAO.Field
Dim fieldType As String
Dim i As Integer
    
    Set db = CurrentDb
    
     'テーブル定義を取得
    Set td = db.TableDefs(Me.テーブル名検索.Value)
    ' フィールド定義を取得
    Set fld = td.Fields(Me.フィールド名検索.Value)
        
    SQL = "SELECT " & Me.フィールド名検索 & " FROM " & Me.テーブル名検索 & ";"
    
    Set rs = db.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges)
    
    '左から残す文字数テキストボックスが空白の時にメッセージを出す
    If Me.左から残す文字数 = "" Or IsNull(Me.左から残す文字数) Then
        MsgBox "左から残す文字数を入力して下さい。"
        Exit Sub
    End If
    
    i = Me.左から残す文字数
    変換フィールド名 = Me.フィールド名検索
    
    '指定したフィールドがテキスト型のみ変換処理を実行する。
    If fld.Type = dbText Then
        Do Until rs.EOF
        'テキスト型のフィールドの変換
            rs.Edit
            If Not IsNull(rs(変換フィールド名)) And Len(rs(変換フィールド名)) > i Then
                leftPart = Left(rs(変換フィールド名), i) ' 先頭から(i)文字を残す
                starPart = String(Len(rs(変換フィールド名)) - i, "*") ' 残りを*で埋める
                rs(変換フィールド名) = leftPart & starPart
                
                rs.Update
            End If
            rs.MoveNext
        Loop
        rs.Close
        MsgBox "変更が完了しました"
        Exit Sub
    End If
    
    MsgBox "文字列型ではありません"
   End Sub