2017年9月2日土曜日

[VBA] MSAccessテーブルのレコード数を確認する

MSAccessテーブルのレコード数を、Excelにまとめて出力するサンプルです。

Dim Engine As DAO.DBEngine
Dim Database As DAO.Database
Dim TableDef As DAO.TableDef

' 3343 データベースの形式を認識できません エラー対策
Set Engine = CreateObject("DAO.DBEngine.120")
Set Database = Engine.OpenDatabase("データベース.accdb")

Dim RowNum As Long
RowNum = 1

For Each TableDef In Database.TableDefs
  If Left(TableDef.Name, 4) = "MSys" Then GoTo CONTINUE
  ' リンクテーブルは除外
  If Len(TableDef.Connect) > 0 Then GoTo CONTINUE

  Debug.Print TableDef.Name
  Cells(RowNum, 1).Value = TableDef.Name
  Cells(RowNum, 2).Value = TableDef.RecordCount
  RowNum = RowNum + 1

CONTINUE:
Next

Excelの表をMSAccessテーブルに貼り付けすると、欠落する

Excelで作った表をMSAccessテーブルにコピペすると、欠落するケースがあります。
状況によって事情が異なります。
  • 1行目が欠落するケース
  • 特定のカラムがカットされるケース

■ 1行目が欠落するケース

1行分が消失します。これは見出しチェックが働いて、1行目を見出しとしてカットしてしまうためです。

Access2010にてExcelからAccessテーブルへのコピー+ペーストで登録されないレコードがある。
https://answers.microsoft.com/ja-jp/msoffice/forum/msoffice_access-mso_other/access2010%E3%81%AB%E3%81%A6excel%E3%81%8B/6192e312-a292-49e3-9ce5-65e15e5238d0


■ 特定のカラムがカットされるケース

1行目以降でも発生するものです。

1.テキスト型なのに、数値だけで構成されることが多いケース

(例)テーブル定義
フィールド1 (テキスト型)
フィールド2 (テキスト型)
フィールド3 (テキスト型)

コピペするExcelのデータ
フィールド1フィールド2フィールド3
id1name1123456
id2name2123456
id3name3123ABCD

これを、MSAccessテーブルに貼り付け
フィールド1フィールド2フィールド3
id1name1123456
id2name2123456
id3name3 
フィールド3の最後の行だけ、消失しています。


2.数値だけで構成されるが、関数で出力したものを含むケース

コピペするExcelのデータ
フィールド1フィールド2フィールド3
id1name1123456
id2name2123456
id3name3123456
数値に見えるが、実際は関数が出力した文字列であったケースです。

これを、MSAccessテーブルに貼り付け
フィールド1フィールド2フィールド3
id1name1123456
id2name2123456
id3name3 
フィールド3最後の行が消失ます。

上記から、テーブルのカラム型ではなく、Excel側でコピーしたデータの型を推測している様子です。

[VBA] CSVファイルの中身をソートする

CSVファイルの内容をソートする方法について

例えば、Excelシートに移してから、Excelの機能で並び替える。
(少量ならプログラム無くても可能)

これをVBAで繰り返しやるとしたら、例えば
Dim Fso As New Scripting.FileSystemObject
Dim List As Object
Set List = CreateObject("System.Collections.ArrayList")

Dim Fin As TextStream
Set Fin = Fso.OpenTextFile(Filename:="csvファイル1.csv")
Do Until Fin.AtEndOfLine
  List.Add (Fin.ReadLine)
Loop
Fin.Close

List.Sort

Dim Fout As TextStream
Set Fout = Fso.CreateTextFile(Filename:="csvファイル2.csv")
Dim Value As Variant
For Each Value In List
  Debug.Print Value
  Fout.WriteLine Value
Next
Fout.Close