ExcelでSQLを使う-024: ソース公開-08 getFieldInfo関数（Excel To Excel）

生後14日目。

仔犬たちの体重は1.3Kg～1.5Kgに。

大きなお腹を曝け出して臍天で寝ることも多くなりました。

◇◇◇◇◇

　本稿で公開する getFieldInfo関数は、（それ自体が）エクセルで作表するのに何らかの貢献をするものではありません。DSelect関数が検索したデータを書き出すXlsWriter関数などを書く上で必要な情報を知る、あるいはDSelect関数で指定する＜列名＞を確認するのに役立つだけのものです。

８、表の情報を調べるgetFiledInfo関数

　このような表をADOはどのように認識するのか？それを示しているのが次の図です。

　《ヘッダーなし》を指定すると、ADOは＜F1＞＜F2＞・・・＜Fn＞という列名を生成することがわかります。

　さて、次のような場合は？

　このように認識します。

　確かに、この程度の情報は、ネットで調べても知ることができます。でも、そこはやはり自分で確かめることも大事です。getFieldInfo関数は、その手助けをする関数です。

getFiledInfo関数

Public Function getFieldInfo(ByVal strSQL As String, _
　　　　　　　　　　　　　　 Optional ByVal colDelimita As String = ";", _
　　　　　　　　　　　　　　 Optional ByVal xlFileName As String = "", _
　　　　　　　　　　　　　　 Optional ByVal isHeader As Boolean = True) As String
On Error GoTo Err_getFieldInfo
　　'
　　' 【要参照設定】
　　'
　　' Micrsoft ActiveX Data Objects 2.8 Library
　　'
　　Dim strHDR　As String
　　Dim cnn　　 As ADODB.Connection
　　Dim rst　　 As ADODB.Recordset
　　Dim fld　　 As ADODB.Field
　　Dim strList As String　' 全てのデータを区切子で連結して格納
　
　　Set cnn = New ADODB.Connection
　　Set rst = New ADODB.Recordset
　　'
　　' ThisWorkbook.FullName の指定
　　'
　　If Len(xlFileName) = 0 Then
　　　　 xlFileName = ThisWorkbook.FullName
　　End If
　　'
　　' 接続設定
　　'
　　With cnn
　　　　strHDR = IIf(isHeader, "HDR=YES;", "HDR=NO;")
　　　　.Provider = "Microsoft.ACE.OLEDB.12.0"
　　　　.Properties("Extended Properties") = "Excel 12.0;" & strHDR & "IMEX=1;"
　　　　.Open xlFileName
　　　　'
　　　　' 列を読み込み
　　　　'
　　　　With rst
　　　　　　.Open strSQL, cnn, adOpenKeyset, adLockReadOnly
　　　　　　If Not .BOF Then
　　　　　　　　.MoveFirst
　　　　　　　　strList = "Name（名前）: "
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　strList = strList & .Name & colDelimita
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　strList = Replace(strList & "[END]", ";[END]", "") & Chr(13)
　　　　　　　　strList = strList & "Value（値）: "
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　strList = strList & .Value & colDelimita
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　strList = Replace(strList & "[END]", ";[END]", "") & Chr(13)
　　　　　　　　strList = strList & "Type（型）: "
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　strList = strList & .Type & colDelimita
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　strList = Replace(strList & "[END]", ";[END]", "") & Chr(13)
　　　　　　　　strList = strList & "Precision（精度）: "
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　strList = strList & .Precision & colDelimita
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　Else
　　　　　　　　strList = ""
　　　　　　End If
　　　　End With
　　End With
　　getFieldInfo = IIf(Len(strList) > 0, Replace(strList & "[END]", ";[END]", ""), "")
Exit_GetFieldInfo:
On Error Resume Next
　　rst.Close
　　cnn.Close
　　Set rst = Nothing
　　Set cnn = Nothing
　　Exit Function
Err_getFieldInfo:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(getFieldInfo)" & Chr(13) & Chr(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr(13) & _
　　　　　　"・SQL Text=" & strSQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_GetFieldInfo
End Function

　次は、エクセルの表にデータを追加、更新したり削除するSQLExecute関数を紹介します。