Created
October 25, 2013 01:41
-
-
Save KenjiOhtsuka/7148201 to your computer and use it in GitHub Desktop.
Export Table definitions from Micfosoft Office Access file. アクセスのファイルからテーブル定義をエクスポートするコード。
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ' 参照設定: Microsoft DAO 3.6 Object Library | |
| Option Explicit | |
| Private Const startingRowNumber = 5 | |
| Enum ColumnNumber | |
| TableName = 1 | |
| TableDescription = 2 | |
| Caption = 2 | |
| PrimaryKey = 3 | |
| FieldName = 4 | |
| DataType = 5 | |
| Power = 6 | |
| DecimalPlace = 7 | |
| Required = 8 | |
| DefaultValue = 9 | |
| Memo = 10 | |
| Index = 11 | |
| IndexFieldName = 8 | |
| IndexUnique = 9 | |
| LinkDatabaseHeader = 2 | |
| LinkDatabase = 3 | |
| LinkSourceTableHeader = 2 | |
| LinkSourceTable = 3 | |
| End Enum | |
| Public Sub GetTableDefinitions() | |
| ' choose a .mdb file and get the file name | |
| Dim xlAPP As Application | |
| Set xlAPP = Application | |
| ' get .mdb file path | |
| Dim strFileName As String | |
| strFileName = xlAPP.GetOpenFilename("Access Database (*.mdb),*.mdb", , _ | |
| "Select Access Database") | |
| If StrConv(strFileName, vbUpperCase) = "FALSE" Then Exit Sub | |
| ' record file name | |
| Cells(1, 1).Value = strFileName | |
| ' initialize .xls sheet | |
| Rows("3:65536").ClearContents | |
| ' get database | |
| Dim db As DAO.Database | |
| Set db = OpenDatabase(strFileName) | |
| ' Variables used in loop | |
| Dim counterRowNumber As Integer ' Current Row Number in the sheet | |
| counterRowNumber = startingRowNumber | |
| Dim topRowOfCurrentTable As Integer | |
| Dim tempTable As DAO.TableDef | |
| Dim tempField As DAO.Field | |
| Dim tempProperty As DAO.Property | |
| Dim tempIndex As DAO.Index | |
| Dim tempValue As String | |
| Dim tempValue_1 As String | |
| Dim tempValue_2 As String | |
| Dim counterInt As Integer | |
| Dim counterInt_1 As Integer | |
| Dim primaryKeys() As String | |
| Dim primaryKeyExists As Boolean | |
| Dim stringItems() As String | |
| For Each tempTable In db.TableDefs | |
| ' avoid linked table and system table | |
| If Left(tempTable.Name, 4) <> "MSys" Then | |
| If ((tempTable.Attributes And dbAttachedTable) <> dbAttachedTable) Then | |
| topRowOfCurrentTable = counterRowNumber | |
| ' record Table ID and Table Name | |
| Cells(counterRowNumber, ColumnNumber.TableName).Value = tempTable.Name | |
| For Each tempProperty In tempTable.Properties | |
| Select Case tempProperty.Name | |
| Case "Description" | |
| tempValue = tempProperty.Value | |
| ' convert 半角片仮名 to 全角片仮名 | |
| tempValue = ConvFullHalf(tempValue, VbStrConv.vbWide) | |
| Cells(counterRowNumber, ColumnNumber.TableDescription).Value = tempValue | |
| End Select | |
| Next | |
| counterRowNumber = counterRowNumber + 1 | |
| ' start recording field properties | |
| For Each tempField In tempTable.Fields | |
| tempValue = tempField.Name | |
| Cells(counterRowNumber, ColumnNumber.FieldName).Value = tempValue | |
| tempValue_1 = "" | |
| For Each tempProperty In tempField.Properties | |
| Select Case tempProperty.Name | |
| Case "Caption": ' 標題 | |
| tempValue = CStr(tempProperty.Value) | |
| ' convert 半角片仮名 to 全角片仮名 | |
| tempValue = ConvFullHalf(tempValue, VbStrConv.vbWide) | |
| Cells(counterRowNumber, ColumnNumber.Caption).Value = tempValue | |
| Case "Required": ' 値要求 | |
| If tempProperty.Value Then | |
| Cells(counterRowNumber, ColumnNumber.Required).Value = "不可" | |
| End If | |
| Case "DefaultValue": ' 規定値 | |
| tempValue = CStr(tempProperty.Value) | |
| Select Case tempValue | |
| Case "Date()", "Now ()", "Time()" | |
| tempValue = "SYSDATE" | |
| End Select | |
| Cells(counterRowNumber, ColumnNumber.DefaultValue).Value = "'" & tempValue | |
| Case "Format", "ValidationRule", "InputMask" | |
| tempValue = tempProperty.Value | |
| ' modify data | |
| If tempProperty.Name = "Format" Then | |
| tempValue = Replace(tempValue, "yyyy/mm/dd", "yyyy/MM/dd") | |
| tempValue = "'" & tempValue & "'" | |
| End If | |
| If tempProperty.Name = "InputMask" Then | |
| tempValue = "'" & tempValue & "'" | |
| End If | |
| ' record | |
| If Cells(counterRowNumber, ColumnNumber.Memo).Value = "" Then | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value = "'" & tempValue | |
| Else | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value = _ | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value & ", " & tempValue | |
| End If | |
| Case "RowSourceType" | |
| If tempProperty.Value = "Value List" Then | |
| tempValue = tempField.Properties("RowSource").Value ' record | |
| If Cells(counterRowNumber, ColumnNumber.Memo).Value = "" Then | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value = "'" & tempValue | |
| Else | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value = _ | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value & ", " & tempValue | |
| End If | |
| End If | |
| Case "Description" ' 備考 | |
| tempValue_1 = tempProperty.Value | |
| Case Else: | |
| tempValue = CStr(tempProperty.Name) | |
| Cells(counterRowNumber, ColumnNumber.Memo + 1).Value = _ | |
| Cells(counterRowNumber, ColumnNumber.Memo + 1).Value & ", " & CStr(tempProperty.Name) | |
| End Select | |
| Next | |
| ' add 備考 to the last of Memo field | |
| If tempValue_1 <> "" Then | |
| If Cells(counterRowNumber, ColumnNumber.Memo).Value = "" Then | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value = "'" & tempValue_1 | |
| Else | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value = _ | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value & ", " & tempValue_1 | |
| End If | |
| End If | |
| ' if caption is not set, copy id to caption. | |
| If Cells(counterRowNumber, ColumnNumber.Caption).Value = "" Then | |
| Cells(counterRowNumber, ColumnNumber.Caption).Value = _ | |
| Cells(counterRowNumber, ColumnNumber.FieldName).Value | |
| End If | |
| ' record field tyle | |
| Select Case tempField.Type | |
| Case 1: ' Yes/No 型 | |
| tempValue = "NUMBER" | |
| tempValue_1 = "1" | |
| tempValue_2 = "0" | |
| Case 2: ' バイト型 | |
| tempValue = "NUMBER" | |
| tempValue_1 = "3" | |
| tempValue_2 = "0" | |
| Case 3: ' 整数 (-32768 - 32768) | |
| tempValue = "NUMBER" | |
| tempValue_1 = "5" | |
| tempValue_2 = "0" | |
| Case 4: ' 長整数型 又は オートナンバー | |
| tempValue = "NUMBER" | |
| tempValue_1 = "10" | |
| tempValue_2 = "0" | |
| If (tempField.Attributes And dbAutoIncrField) = dbAutoIncrField Then | |
| If Cells(counterRowNumber, ColumnNumber.Memo).Value = "" Then | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value = "シーケンス使用" | |
| Else | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value = _ | |
| Cells(counterRowNumber, ColumnNumber.Memo).Value & ", シーケンス使用" | |
| End If | |
| End If | |
| Case 5: ' 通貨型 | |
| tempValue = "NUMBER" | |
| tempValue_2 = CStr(tempField.Properties("DecimalPlaces").Value) | |
| If Information.IsNumeric(tempValue_2) Then | |
| If CInt(tempValue_2) < 0 Or CInt(tempValue_2) > 4 Then | |
| tempValue_2 = "4" | |
| End If | |
| Else | |
| tempValue_2 = "4" | |
| End If | |
| tempValue_1 = CStr(15 + CInt(tempValue_2)) | |
| Case 7 ' 倍精度浮動小数点型 | |
| ' 38-digits floating point | |
| tempValue = "NUMBER" | |
| tempValue_1 = "" | |
| tempValue_2 = "" | |
| Case 8: ' 日付/時刻型 | |
| tempValue = "DATE" | |
| tempValue_1 = "" | |
| tempValue_2 = "" | |
| Case 10: ' テキスト | |
| tempValue = "VARCHAR2" | |
| tempValue_1 = tempField.Size | |
| tempValue_2 = "" | |
| Case 11 ' OLEオブジェクト型 | |
| tempValue = "BLOB" | |
| tempValue_1 = "" | |
| tempValue_2 = "" | |
| Case 12 ' メモ型 又は ハイパーリンク型 | |
| tempValue = "VARCHAR2" | |
| tempValue_1 = "4000" | |
| tempValue_2 = "" | |
| '' take care for character code when you using CLOB. | |
| '' CLOB don't work correctly | |
| '' in variable character code like AL16UTF16. | |
| ' tempValue = "CLOB" | |
| ' tempValue_1 = "" | |
| ' tempValue_2 = "" | |
| Case Else: | |
| tempValue = tempField.Type | |
| tempValue_1 = "" | |
| tempValue_2 = "" | |
| End Select | |
| Cells(counterRowNumber, ColumnNumber.DataType).Value = tempValue | |
| Cells(counterRowNumber, ColumnNumber.Power).Value = tempValue_1 | |
| Cells(counterRowNumber, ColumnNumber.DecimalPlace).Value = tempValue_2 | |
| ' move to next row | |
| counterRowNumber = counterRowNumber + 1 | |
| Next | |
| ' end recording field properties | |
| ' record primary key column | |
| primaryKeyExists = False | |
| For Each tempIndex In tempTable.Indexes | |
| If tempIndex.Primary = True Then | |
| For Each tempField In tempIndex.Fields | |
| If Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value = "" Then | |
| Cells(counterRowNumber, ColumnNumber.Caption).Value = "PK_" & tempTable.Name | |
| Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value = tempField.Name | |
| Else | |
| Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value = _ | |
| Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value & _ | |
| ", " & tempField.Name | |
| End If | |
| Next | |
| primaryKeyExists = True | |
| End If | |
| Next | |
| ' mark columns of primary key | |
| If primaryKeyExists Then | |
| primaryKeys = Split(CStr(Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value), ", ") | |
| For counterInt_1 = 0 To UBound(primaryKeys) | |
| For counterInt = topRowOfCurrentTable To counterRowNumber - 1 | |
| If Cells(counterInt, ColumnNumber.FieldName) = primaryKeys(counterInt_1) Then | |
| Cells(counterInt, ColumnNumber.PrimaryKey).Value = "○" | |
| Exit For | |
| End If | |
| Next | |
| Next | |
| counterRowNumber = counterRowNumber + 1 | |
| End If | |
| ' start recording index except for primary key | |
| counterInt = 1 | |
| For Each tempIndex In tempTable.Indexes | |
| If tempIndex.Primary = False Then | |
| For Each tempField In tempIndex.Fields | |
| tempValue = tempField.Name | |
| If primaryKeyExists Then | |
| For counterInt_1 = 0 To UBound(primaryKeys) | |
| If tempValue = primaryKeys(counterInt_1) Then | |
| tempValue = "" | |
| Exit For | |
| End If | |
| Next | |
| End If | |
| If tempValue <> "" Then | |
| tempValue_1 = "1" | |
| If Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value = "" Then | |
| Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value = _ | |
| tempValue | |
| Else | |
| Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value = _ | |
| Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value & _ | |
| ", " & tempValue | |
| End If | |
| End If | |
| Next | |
| If Cells(counterRowNumber, ColumnNumber.IndexFieldName).Value <> "" Then | |
| ' when more than one index is recorded | |
| Cells(counterRowNumber, ColumnNumber.Caption).Value = _ | |
| "ID_" & tempTable.Name & CStr(counterInt) | |
| If tempIndex.Unique = True Then | |
| Cells(counterRowNumber, ColumnNumber.IndexUnique).Value = "○" | |
| End If | |
| counterRowNumber = counterRowNumber + 1 | |
| counterInt = counterInt + 1 | |
| End If | |
| End If | |
| Next | |
| ' end recording index | |
| Else | |
| ' record Table ID and Table Name | |
| Cells(counterRowNumber, ColumnNumber.TableName).Value = tempTable.Name | |
| Cells(counterRowNumber, ColumnNumber.TableDescription).Value = "リンクテーブル" | |
| counterRowNumber = counterRowNumber + 1 | |
| ' record table source | |
| stringItems = Split(tempTable.Connect, ";") | |
| For counterInt = 0 To UBound(stringItems) | |
| If Left(stringItems(counterInt), 9) = "DATABASE=" Then | |
| Cells(counterRowNumber, ColumnNumber.LinkDatabaseHeader).Value = "元データベース" | |
| Cells(counterRowNumber, ColumnNumber.LinkDatabase).Value = stringItems(counterInt) | |
| counterRowNumber = counterRowNumber + 1 | |
| Cells(counterRowNumber, ColumnNumber.LinkSourceTableHeader).Value = "元テーブル" | |
| Cells(counterRowNumber, ColumnNumber.LinkSourceTable).Value = tempTable.SourceTableName | |
| counterRowNumber = counterRowNumber + 1 | |
| Exit For | |
| End If | |
| Next | |
| counterRowNumber = counterRowNumber + 1 | |
| End If | |
| ' move to next row for new table | |
| counterRowNumber = counterRowNumber + 1 | |
| End If | |
| Next | |
| Set db = Nothing | |
| Set xlAPP = Nothing | |
| End Sub | |
| ' http://www.vbalab.net/vbaqa/data/excel/log/tree_325.htm にあったので借用 | |
| Private Function ConvFullHalf(ByVal targetString As String, _ | |
| Optional ByVal optKana As Integer = 0, _ | |
| Optional ByVal optHira As Integer = 0, _ | |
| Optional ByVal optAlph As Integer = 0, _ | |
| Optional ByVal optDigt As Integer = 0, _ | |
| Optional ByVal optSymb As Integer = 0, _ | |
| Optional ByVal optSpac As Integer = 0) As String | |
| Dim character As String | |
| Dim resultString As String | |
| Do Until targetString = "" | |
| character = Left(targetString, 1) | |
| targetString = Right(targetString, Len(targetString) - 1) | |
| Select Case character | |
| Case "ぁ" To "ん" ' ひらがな | |
| resultString = resultString & StrConv(character, optHira) | |
| Case "A" To "Z", "a" To "z", "Ａ" To "Ｚ", "ａ" To "ｚ" ' アルファベット | |
| resultString = resultString & StrConv(character, optAlph) | |
| Case "0" To "9", "０" To "９" ' 数字 | |
| resultString = resultString & StrConv(character, optDigt) | |
| Case " ", " " 'スペース | |
| resultString = resultString & StrConv(character, optSpac) | |
| Case Else | |
| Select Case Left(StrConv(character, vbNarrow), 1) | |
| Case Chr(&H21) To Chr(&H2F), _ | |
| Chr(&H3A) To Chr(&H40), _ | |
| Chr(&H5B) To Chr(&H60), _ | |
| Chr(&H7B) To Chr(&H7E) ' 記号 | |
| resultString = resultString & StrConv(character, optSymb) | |
| Case Chr(&HA1) To Chr(&HDF) ' カタカナ | |
| If Left(targetString, 1) = Chr(&HDE) Or _ | |
| Left(targetString, 1) = Chr(&HDF) Then | |
| resultString = resultString & StrConv(character & Left(targetString, 1), optKana) | |
| targetString = Right(targetString, Len(targetString) - 1) | |
| Else | |
| resultString = resultString & StrConv(character, optKana) | |
| End If | |
| Case Else | |
| resultString = resultString & character | |
| End Select | |
| End Select | |
| Loop | |
| ConvFullHalf = resultString | |
| End Function |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment