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 が出てきた。(ガックリ)