VBA: How to List Table Definitions in Access File

In this article, we will introduce code that converts a list of table definitions within Microsoft Office Access(アクセス) (.mdb) files into Oracle-compatible table definitions and outputs them as a list.

Overview

We will use Excel and VBA for this process.
By running the VBA function GetTableDefinitions, you can output a list of table definitions from an Access file to the open Excel sheet.
We will create text data intended to be pasted into a table definition document (.xls).
For Access tables converted to Oracle, text columns, for example, will be displayed as VARCHAR2.
We won’t output system tables (you can modify the code to include them if needed).
Link tables will display the contents of the links. The definitions of linked destination tables will not be output.

How to Use

Open Excel.
Open the Visual Basic Editor from the development tools.
Add a module.
Check Microsoft DAO in the Tools > References settings.
Paste the code below.
Execute the GetTableDefinitions function.

コード

' 参照設定: 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 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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

' 参照設定: 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 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

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

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

' 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

' 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

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

' 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

primaryKeyExists = True

End If

' 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

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

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

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 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

counterRowNumber = counterRowNumber + 1

End If

' move to next row for new table

counterRowNumber = counterRowNumber + 1

End If

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

Loop

ConvFullHalf = resultString

End Function

The Life

VBA: How to List Table Definitions in Access File

Overview

How to Use

コード

Related Posts

Readers who viewed this page, also viewed:

A Life Summary of an Gypsy