スキルアップ・問題解決なら、モーグにおまかせ！

DAOでテーブルのもともとのルックアップ設定されていないフィールドをルックアップされる"複数の値の許可"へ設定変更しようとしています。
しかしうまくいきません。
 
対象となるフィールドのデータ型は「短いテキスト：２５５文字」
 
やってみたことを書き出してみます。
 

Dim tc As DAO.TableDef
Dim td As DAO.TableDef
Dim fld As DAO.Field

With CurrentDb

Set td = .TableDefs("ConData")
Set fld = td("Labels")

'◆やってみたこと�@
'  元々の何の変哲もないフィールドに対して設定を変更させてみます。
fld.Properties("DisplayControl") = 111
fld.Properties.Append fld.CreateProperty("AllowMultipleValues", dbBoolean, True)
fld.Properties.Append fld.CreateProperty("RowSourceType", dbText, "Table/Query")
fld.Properties.Append fld.CreateProperty("RowSource", dbText, "tbl_Labels")
fld.Properties.Append fld.CreateProperty("LimitToList", dbBoolean, True)

'↑ここまではOK
'↓データ型を変更させられません：以下のセクションを上記の冒頭に持っていってもダメ
fld.Type = 109 ' Error 3219：無効な処理です
fld.Attributes = 1 ' Error 3219：無効な処理です
fld.Properties("Precision") = 3 ' 値が変化しません：そもそもこれは変更しなくてもいいのかな

'  ここまでで上記のエラーを無視して進め、テーブルをデータシートビューにしようとテーブル名をダブルクリックすると
'┃複数の値を格納できるように'Labels'ルックアップ列を変更しました。
'┃テーブルを保存した後に、この変更を戻すことが出来ません
'┃！複数の値を格納するように'Labels'を変更してもよろしいですか？
'┃　[はい][いいえ]
' のようなダイアログが表示されます。
' ここで[はい]とすれば目的のテーブルが完成します。
' なので、手動ではなくVBAで
' DoCmd.OpenTable "ConData", acViewNormal
' としてみますが、これでは上記の警告メッセージが表示されませんでした。


'◆やってみたこと�A
'  別のテーブルに"複数の値の許可"を設定したフィールドをワーク的に作成
'  そのフィールドを対象テーブルにAppendしてみようとすると
Set tc = .TableDefs("ComplexFieldOnly")
Set fld = td.CreateField(tc(0))
td.Fields.Append fld ' Error 3259：フィールドの型が正しくありません

End With

引用:
DAOでテーブルのもともとのルックアップ設定されていないフィールドを
ルックアップされる"複数の値の許可"へ設定変更

引用:
Dim fld As DAO.Field

引用:
fld.Type = 109

Propertiesで値を変更するようなダイレクトで制御する方法は無さそうなのですね
有無が判断できるだけで感謝です
 
ということで、まだとっかかっていませんが
 
⓪ 必要最大数の"複数の値の許可"のフィールドを設置したテーブルを用意
�@ そのテーブルをコピー
�A 不要な分の"複数の値の許可"のフィールドを削除
�B そのほかの必要な分のフィールドを作成
�C OrdinalPositionを調整
 
でやってみようかと考えていたところです
ちょっと仕組化がしんどいですがチクチクやってみようと思います

こんにちは。
 
当方 複数の値の許可 を行ったフィールドを使った事が無いのですが
　複数の値の 機能が実装される以前、リストボックスの複数選択と何か違うのでしょうか？
　　1対多 の リレーションになる構造を、1テーブル内で実装できる という事なのでしょうか？
 
その前提で
そもそも、「複数の値の許可」をVBAを用いる目的はなんでしょうか？
テーブルのデータシートビュー操作を完結させたいから、手動で 設定してしまえば良いと思います。
 
1対多 で済む話なら、そちらの方が汎用性は高いと思います。
 
知的好奇心なのであれば問題は良いのですが、
運用の仕組みの中で頻繁に発生するので VBA でおこなう必要性があるのであれば
テーブル設計に問題がある可能性が高いです。

一つのデータに対して複数のラベルを付けたいのです。
 
そうすると中間テーブルが発生し多対多リレーションになってしまい、ただの表示用途なのに逆にそこまでする必要ないかなと思った次第です。
工夫してデータをセパレータを挟んで１つのフィールドにするような感じも考えられますが仕組みが面倒です。
データ1・・・ラベルA , ラベルB
データ2・・・ラベルA , ラベルC
 
仕掛けを作らずコンボ＆チェックボックスで手軽にセレクトできるのも旨みです。
 
そしてこんな感じのフィールドが状況次第で存在しなかったり複数あったりで不安定な仕様なのも要因の一つです。

とりあえずサンプルコードを挙げると次のような感じかと。
 
（標準モジュール）
------------------------------------------------------------------------

Sub AlterFieldTypeToComplex()
On Error GoTo Err_AlterFieldTypeToComplex

    Const TargetTableName As String = "ConData"
    Const TargetFieldName As String = "Labels"
    Const NewRowSource As String = "tbl_Labels"

    Dim ws As DAO.Workspace
    Set ws = DBEngine.Workspaces(0)
    
    Dim db As DAO.Database
    Set db = CurrentDb
    
    Dim tdf As DAO.TableDef
    Set tdf = db.TableDefs(TargetTableName)
    
    Dim fldOld As DAO.Field2
    Set fldOld = tdf.Fields(TargetFieldName)
    
    Dim intNewDataType As DAO.DataTypeEnum
    
    '元のデータ型に応じて新しいデータ型を決定
    Select Case fldOld.Type
        'バイト型である場合
        Case dbByte
            '複数値バイト型に
            intNewDataType = dbComplexByte
        '10 進型である場合
        Case dbDecimal
            '複数値 10 進型に
            intNewDataType = dbComplexDecimal
        '倍精度浮動小数点型である場合
        Case dbDouble
            '複数値倍精度浮動小数点型に
            intNewDataType = dbComplexDouble
        'GUID 型（レプリケーション ID型）である場合
        Case dbGUID
            '複数値 GUID 型に
            intNewDataType = dbComplexGUID
        '整数型である場合
        Case dbInteger
            '複数値整数型に
            intNewDataType = dbComplexInteger
        '長整数型である場合
        Case dbLong
            '複数値長整数型に
            intNewDataType = dbComplexLong
        '単精度浮動小数点型である場合
        Case dbSingle
            '複数値単精度浮動小数点型に
            intNewDataType = dbComplexSingle
        'テキスト型である場合
        Case dbText
            '複数値テキスト型に
            intNewDataType = dbComplexText
        'いずれかの複数値データ型である場合
        Case dbComplexByte, dbComplexDecimal, dbComplexDouble, _
             dbComplexGUID, dbComplexInteger, dbComplexLong, _
             dbComplexSingle, dbComplexText
            'エラーメッセージを表示
            MsgBox "テーブル定義[" & TargetTableName & "]のフィールド[" & fldOld.Name & "]は複数の値を持つフィールドです。", _
                   vbExclamation, _
                   "変更不要のフィールド (AlterFieldTypeToComplex)"
            Set fldOld = Nothing
            Set tdf = Nothing
            Set db = Nothing
            Set ws = Nothing
            'プロシージャを抜ける
            Exit Sub
        '上記以外の型である場合
        Case Else
            'エラーメッセージを表示
            MsgBox "テーブル定義[" & TargetTableName & "]のフィールド[" & fldOld.Name & "]の現在のデータ型は複数値をサポートしていません。", _
                   vbExclamation, _
                   "データ型変換エラー (AlterFieldTypeToComplex)"
            Set fldOld = Nothing
            Set tdf = Nothing
            Set db = Nothing
            Set ws = Nothing
            'プロシージャを抜ける
            Exit Sub
    End Select
    
'トランザクション処理を開始
    
    ws.BeginTrans
    On Error GoTo RollBack_AlterFieldTypeToComplex
    
'複数の値を持つフィールドを新規作成する
    
    Dim strTempFieldName As String
    
    '仮のフィールド名を設定
    strTempFieldName = fldOld.Name & "_New"
    
    Dim fldNew As DAO.Field2
    
    '新規フィールドの生成
    Set fldNew = tdf.CreateField(strTempFieldName)
    
    '新しいデータ型（いずれかの複数値データ型）を設定
    fldNew.Type = intNewDataType
    '属性を複写
    fldNew.Attributes = fldOld.Attributes
    'テーブル定義上の順番を複写
    fldNew.OrdinalPosition = fldOld.OrdinalPosition
    
    '新規フィールドをテーブル定義に追加
    tdf.Fields.Append fldNew
    tdf.Fields.Refresh
    
    Set fldNew = Nothing
    
    '追加後のフィールドを参照
    Set fldNew = tdf.Fields(strTempFieldName)
    
    'ユーザー定義プロパティの設定例（実際はもっと色々やった方が良いが、とりあえずルックアップ周りのみ）
    With fldNew.Properties

        .Append fldNew.CreateProperty("AllowMultipleValues", dbBoolean, True)
        .Append fldNew.CreateProperty("DisplayControl", dbInteger, acComboBox)
        .Append fldNew.CreateProperty("RowSourceType", dbText, "Table/Query")
        If NewRowSource <> "" Then
            .Append fldNew.CreateProperty("RowSource", dbMemo, NewRowSource)
        End If
        .Append fldNew.CreateProperty("BoundColumn", dbInteger, 1)
        .Append fldNew.CreateProperty("ColumnCount", dbInteger, 1)
        .Append fldNew.CreateProperty("ColumnHeads", dbBoolean, False)
        .Append fldNew.CreateProperty("ListRows", dbInteger, 16)
        .Append fldNew.CreateProperty("ListWidth", dbText, "0twip")
        .Append fldNew.CreateProperty("LimitToList", dbBoolean, False)
        .Append fldNew.CreateProperty("AllowValueListEdits", dbBoolean, False)
        .Append fldNew.CreateProperty("ShowOnlyRowSourceValues", dbBoolean, False)
        .Refresh
        
    End With
    
    'フィールドおよびテーブル定義への参照を解放
    Set fldNew = Nothing
    Set fldOld = Nothing
    Set tdf = Nothing
    
'格納済みのレコードのデータ変換処理
    
    Dim rsTarget As DAO.Recordset2
    Dim rsComplex As DAO.Recordset2
    
    '変換対象となるフィールドを含むテーブルのレコードセットを開く
    Set rsTarget = db.OpenRecordset(TargetTableName, dbOpenDynaset)
    
    '全てのレコードを読み切るまでループ
    Do Until rsTarget.EOF
        
        Set fldOld = rsTarget.Fields(TargetFieldName)
        Set fldNew = rsTarget.Fields(strTempFieldName)
        
        '変換元のフィールドの値が Null ではない場合
        If Not IsNull(fldOld.Value) Then
            'カレントレコードの編集を開始
            rsTarget.Edit
            '変換先が複数値フィールドである場合
            If fldNew.IsComplex Then
                '複数値フィールドのレコードセットを参照する
                Set rsComplex = fldNew.Value
                'そのレコードセットに新規レコードを追加し、変換元のフィールドの値を代入して保存
                rsComplex.AddNew
                rsComplex.Fields("Value") = fldOld.Value
                rsComplex.Update
                'そのレコードセットへの参照を解放
                Set rsComplex = Nothing
            '変換先が複数値フィールドではない場合
            Else
                '変換元のフィールドの値をそのまま代入
                fldNew.Value = fldOld.Value
            End If
            'カレントレコードを保存
            rsTarget.Update
        End If
        
        Set fldNew = Nothing
        Set fldOld = Nothing
        
        '次のレコードを移動
        rsTarget.MoveNext
    Loop
    
    'レコードセットへの参照を解放
    Set rsTarget = Nothing
    
'新旧フィールドの入れ替え
    
    'テーブル定義を再参照
    Set tdf = db.TableDefs(TargetTableName)
    
    '元のフィールドを削除する
    tdf.Fields.Delete TargetFieldName
    '新しく追加したフィールドの名前を元のフィールドと同じ名前にリネームする
    tdf.Fields(strTempFieldName).Name = TargetFieldName
    
'コミット（全ての変更を有効にしてトランザクション処理を終了）
    
    ws.CommitTrans
    On Error GoTo Err_AlterFieldTypeToComplex
    
    '成功時のメッセージ表示
    MsgBox "テーブル定義[" & TargetTableName & "]のフィールド[" & TargetFieldName & "]を複数の値を持つフィールドに変更しました。", _
           vbInformation, _
           "実行完了 (AlterFieldTypeToComplex)"
    
'終了処理
Exit_AlterFieldTypeToComplex:
On Error Resume Next
    
    Set fldNew = Nothing
    Set fldOld = Nothing
    Set rsComplex = Nothing
    Set rsTarget = Nothing
    Set tdf = Nothing
    Set db = Nothing
    Set ws = Nothing
    
    'プロシージャを抜ける
    Exit Sub

'トランザクション実行中はここからエラー時処理
RollBack_AlterFieldTypeToComplex:
    
    'ロールバック（全ての変更を取り消してトランザクション処理を終了）
    ws.Rollback

'エラー時処理
Err_AlterFieldTypeToComplex:

    Dim ErrMsg As String
    
    ErrMsg = Err.Number & ": " & Err.Description
    Debug.Print ErrMsg
    
    'エラーメッセージの表示
    MsgBox ErrMsg, vbCritical, "実行時エラー(AlterFieldTypeToComplex)"
    
    '終了処理へ
    Resume Exit_AlterFieldTypeToComplex
End Sub

わざわざコード提示ありがとうございます。
 
すみませんこちらボケてました。
フィールドの属性変更や元のフィールドを削除する手法ではなく
素直にフィールドを追加すればいいだけのお話でした。
お騒がせしました。