[AC97]VBAから Schema.ini ファイルを作成する方法

  プロシージャ名：CreateSchemaFile
  引数：bIncFldNames - True/Falseでテキスト ファイルの最初の行に列名の有無を
                       指定します。
               sPath - Schema.ini が保存されるフォルダへの完全なパス。
        sSectionName - Schema.ini セクション名。(テキスト ファイルの名前と
                       同じ)
         sTblQryName - Schema.ini ファイルを作成するテーブルまたはクエリーの
                       名前。
  -----------------------------------------------------------------------------
  Public Function CreateSchemaFile(bIncFldNames As Boolean, sPath As String, _
                    sSectionName As String, sTblQryName As String) As Boolean
      Dim Msg As String
      Dim ws As Workspace, db As Database
      Dim tblDef As TableDef, fldDef As Field
      Dim i As Integer, Handle As Integer
      Dim fldName As String, fldDataInfo As String
      
      On Error GoTo CreateSchemaFile_Err
      'テキスト形式(区切り記号付き)でエクスポートします。
      DoCmd.TransferText acExportDelim, , sTblQryName, sPath & "\" & _
              sSectionName, bIncFldNames
      ' スキーマ ファイルを開きます。
      Handle = FreeFile
      Open sPath & "\schema.ini" For Output Access Write As #Handle
      ' スキーマ ファイルのヘッダーを書き込みます。
      Print #Handle, "[" & sSectionName & "]"
      Print #Handle, "ColNameHeader=" & IIf(bIncFldNames, "True", "False")
      Print #Handle, "CharacterSet=ANSI"
      Print #Handle, "Format=CSVDelimited"
      ' スキーマ ファイルに情報を設定します。
      Set db = CurrentDb()
      Set tblDef = db.TableDefs(sTblQryName)
      With tblDef
          For i = 0 To .Fields.Count - 1
              Set fldDef = .Fields(i)
              With fldDef
                  fldName = .Name
                  Select Case .Type
                      Case dbBoolean
                          fldDataInfo = "Bit"
                      Case dbByte
                          fldDataInfo = "Byte"
                      Case dbInteger
                          fldDataInfo = "Short"
                      Case dbLong
                          fldDataInfo = "Long"
                      Case dbCurrency
                          fldDataInfo = "Currency"
                      Case dbSingle
                          fldDataInfo = "Single"
                      Case dbDouble
                          fldDataInfo = "Double"
                      Case dbDate
                          fldDataInfo = "DateTime"
                      Case dbText
                          fldDataInfo = "Char Width " & Format$(.Size)
                      Case dbLongBinary
                          fldDataInfo = "Memo"
                      Case dbMemo
                          fldDataInfo = "Memo"
                      Case dbGUID
                          fldDataInfo = "Char Width 16"
                  End Select
                  Print #Handle, "Col" & Format$(i + 1) & "=" & fldName & _
                           Space$(1) & fldDataInfo
              End With
          Next i
      End With
      MsgBox sPath & "SCHEMA.INI を作成しました。"
      CreateSchemaFile = True
  CreateSchemaFile_End:
      Close Handle
      Exit Function
  CreateSchemaFile_Err:
      Msg = "エラー番号 " & Format$(Err.Number) & vbCrLf
      Msg = Msg & Err.Description
      MsgBox Msg
      Resume CreateSchemaFile_End
  End Function
  -----------------------------------------------------------------------------