文字化け、記号の含まれるフィールド抽出

質問

アクセス初心者です。
現在6万件ほどの住所と名前のデーターべースから、文字化けしていたり記号が入っているデータを探し出すクエリを作成していますが、なかなかうまくいきません。

1.　文字化けを探し出すことは可能でしょうか？

2.　記号が入っているフィールドを探しだすいい方法は無いでしょうか？

3.　名前のフィールドに文字列に数値が入っているものも抽出したいのです。

皆さんでしたら、どのように記述しますか？
ど素人な質問ですみません。
どなたかアドバイスをよろしくお願いします。

回答No.1

noname#140971

<顧客名簿>

ID___顧客名________住所
1____鈴木 一郎____東京都〇
2____中村 太郎____大阪府枚方¶市
3____山田 次郎____兵庫県

このような顧客名簿があるとします。
そこで、イミディエイトウインドウで化け文字があるか否かを SQL文で判定してみます。

[イミディエイトウインドウ]
? DBSelect("SELECT Exist_ShapeCharacter(住所, '〇¶') FROM 顧客名簿"）
-1;
-1;
0

つまり、１番目と２番目のレコードに存在することが判ります。

次に、化け文字があるレコードのみに限定し、その列情報の全てを表示してみます。

? DBSelect("SELECT * FROM 顧客名簿 WHERE Exist_ShapeCharacter(住所, '〇¶')=-1"）
1;鈴木 一郎;1;東京都〇;
2;中村 太郎;1;大阪府枚方¶市;

一体、どのような化け字があるのかが問題ですが・・・。
が、このように複数の化け文字が存在するのか否かをチェックする関数を利用すれば幾つかは確実に引っかかるでしょう。

なお、クエリでは、このように簡単にSQL文をテストできません。
そこで、このようにイミディエイトウインドウでSQL文をテストされた方が手っ取り早いと思います。
そうして、試されずみの SQL文をクエリにコピペするのが簡単。

もちろん、DBSelect()、 Exist_ShapeCharacter() の類は標準モジュールに用意する必要があります。

Public Function Exist_ShapeCharacter(ByVal TEXT As String, ByVal Shapes As String) As Boolean
　　Dim I As Integer
　　Dim L As Integer
　　Dim M As Integer

　　L = Len(Shapes)
　　M = Len(TEXT)
　　For I = 1 To L
　　　　If M <> Len(Replace(TEXT, Mid(Shapes, I, 1), "")) Then
　　　　　　Exist_ShapeCharacter = True
　　　　　　Exit For
　　　　End If
　　Next I
End Function

Public Function DBSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　 Optional ByVal strSeparator As String = ";") As String
On Error GoTo Err_DBSelect
　　Dim I　　 As Integer
　　Dim J　　 As Integer
　　Dim R　　 As Integer
　　Dim C　　 As Integer
　　Dim M　　 As Integer
　　Dim N　　 As Integer
　　Dim rst　 As ADODB.Recordset
　　Dim fld　 As ADODB.Field
　　Dim Datas As String

　　Set rst = New ADODB.Recordset
　　' =================
　　'　Begin With: rst
　　' -----------------
　　With rst
　　　　 .Open strQuerySQL, _
　　　　　　　 CurrentProject.Connection, _
　　　　　　　 adOpenStatic, _
　　　　　　　 adLockReadOnly
　　　　 If Not .BOF Then
　　　　　　M = .RecordCount - 1
　　　　　　N = .Fields.Count - 1
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　For C = 0 To N
　　　　　　　　　　Datas = Datas & .Fields(C) & strSeparator
　　　　　　　　Next C
　　　　　　　　Datas = Datas & vbCrLf
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　 End If
　　End With
　　' ---------------
　　'　End With: rst
　　' ===============
Exit_DBSelect:
　　DBSelect = Left(Datas, Len(Datas) + (Len(Datas) > 0))
　　Exit Function
Err_DBSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function

お礼

とても丁寧にありがとうございます。
一度試しにやってみます。