まりふのひと

テーブルのフィールド名を返す関数

Option Compare Database
Option Explicit
Const MYObjName As String = "modGet_FieldName"

'概要:引数のテーブルのフィールド名を";"で切って返す。
'履歴:H18.11.08    初版
Public Function get_FieldName(argTableName As String) As String
On Error GoTo Err_get_FieldName
Dim mbTitle As String
Dim CNN As New ADODB.Connection
Dim RST As New ADODB.Recordset
Dim FLD As ADODB.Field
Dim strFieldName As String

    mbTitle = MYObjName & "/get_FieldName"
    strFieldName = ""
    Set CNN = CurrentProject.Connection
    With RST
        .Open "xlsDMラベル", CNN, adOpenStatic, adLockOptimistic
        For Each FLD In .Fields
            strFieldName = strFieldName & ";" & FLD.Name
        Next FLD
        .Close
    End With
    If Left(strFieldName, 1) = ";" Then strFieldName = Mid(strFieldName, 2)
    get_FieldName = strFieldName
    
Exit_get_FieldName:
    Set CNN = Nothing
    Exit Function
    
Err_get_FieldName:
    MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
    Resume Exit_get_FieldName
End Function

使用例

テーブル:TBLDMラベル のフィールド名を、テーブル:W_フィールド名 に書き出す。

    fldTable = Split(get_FieldName(TBLDMラベル), ";", -1, vbTextCompare)
    DoCmd.SetWarnings False
    DoCmd.RunSQL "Delete from W_フィールド名"
    For i = 0 To UBound(fldTable)
        DoCmd.RunSQL "INSERT INTO W_フィールド名 (FieldNo, FieldName)" _
                & " SELECT " & i + 1 & ",""" & fldTable(i) & """"
    Next

思ったこと

久しぶりのメンテナンスで、関数を忘れてしまっている! VBAのヘルプ/関数一覧を端から探し、やっと Split, Ubound が出てきた。(ガックリ)