[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テーブルにコピペすると、欠落するケースがあります。
状況によって事情が異なります。

• １行目が欠落するケース
• 特定のカラムがカットされるケース

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

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

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

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

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

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

（例）テーブル定義
フィールド１ （テキスト型）
フィールド２ （テキスト型）
フィールド３ （テキスト型）

コピペするExcelのデータ

フィールド１	フィールド２	フィールド３
id1	name1	123456
id2	name2	123456
id3	name3	123ABCD

これを、MSAccessテーブルに貼り付け

フィールド１	フィールド２	フィールド３
id1	name1	123456
id2	name2	123456
id3	name3

フィールド３の最後の行だけ、消失しています。


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

コピペするExcelのデータ

フィールド１	フィールド２	フィールド３
id1	name1	123456
id2	name2	123456
id3	name3	123456

数値に見えるが、実際は関数が出力した文字列であったケースです。

これを、MSAccessテーブルに貼り付け

フィールド１	フィールド２	フィールド３
id1	name1	123456
id2	name2	123456
id3	name3

フィールド３最後の行が消失ます。

上記から、テーブルのカラム型ではなく、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