アクセス２０００でのレコード新規追加

質問

アクセス２０００です。

社員名簿を毎年更新してＩＤを作成しています。
データはＣＳＶでもらうので、エクセルで「固有ＩＤ」「フリガナ」「漢字氏名」「性別」「生年月日」フィールドを作成し、アクセスのテーブルにインポートします。

貰うデータは既存の社員、新入社員が混ざっています。
なので、新入社員だけを追加して、固有ＩＤを割り付けたいと思います。

そこで、生年月日、性別、さらにフリガナの後ろ３文字をマッチング（結婚などによる改正に対応する）して、同じならば同一人物と判断し、追加しない、マッチングしなければ新規としてレコード追加、更にＩＤを自動的に入力したいのですが、どうすればよいでしょうか？
新規ＩＤは半角でアルファベット１文字＋９桁の数字にしたいです。
最大値＋１でよいです。（例えば、現在使っているＩＤが[y900000001]ならば[y9000000002]を割り付ける。

名簿テーブルを作って、クエリを作成し、そのクエリに計算式フィールド「フリガナ2: Right([フリガナ],3)」を作成しフリガナの後ろ３文字を表示させる事はできましたが、今度はそのクエリから重複クエリで「フリガナ2」フィールドを重複項目に指定するとエラーが発生してしまいました。

「集計関数の一部として指定された式'Count(*)>And[性別]=[クエリ1].[性別]And[フリガナ2]=[クエリ].[フリガナ2]And[生年月日]='を含んでいないクエリを実行しようとしました。」

上記エラーです。

欲を言えば、生年月日、性別、フリガナ後ろ3文字がマッチしたデータは同一人物として判断し、名前に書き換えたいです。ＩＤは変更しないです。
解決方法、宜しくお願いします。

回答No.10

psgrade · ベストアンサー

No.6の補足です。
オブジェクト変数のリセット操作が抜けていました。
予期せぬエラーの原因ともなりかねませんので、下記のように追加して下さい。
Private Function IsExist(ByVal MyTableName As String) As Boolean
Dim i As Integer, MyDb As DAO.Database

Set MyDb = CurrentDb()
IsExist = False
With MyDb
For i = 0 To .TableDefs.Count - 1
If .TableDefs(i).Name = MyTableName Then
IsExist = True
Exit For
End If
Next i

.close

End With

Set MyDb=Nothing

End Function

お礼

大変遅くなりましたが、なんとか目的の事ができました。
今回はpsgradeさんには大変感謝しています。

また、アクセスのことで質問したときには宜しくお願いいたします。
もし、よろしければこちらが私のメールフォームですので、こちらへ返信して下さい。
http://form1.fc2.com/form/?id=534025

OKWAVEに投稿せずアドバイス願えれば助かります。

ありがとうございました。

回答No.9

psgrade

テーブル1抽出：
SELECT [テーブル1].固有ID, [テーブル1].漢字氏名, [テーブル1].[フリガナ], Right([フリガナ],3) AS 抽出フリガナ, [テーブル1].性別, [テーブル1].生年月日
FROM テーブル1;

Tempテーブル抽出：
SELECT Tempテーブル.固有ID, Tempテーブル.漢字氏名, Tempテーブル.[フリガナ], Right([フリガナ],3) AS 抽出フリガナ, Tempテーブル.性別, Tempテーブル.生年月日
FROM Tempテーブル;

のSQLで、テーブル1抽出、Tempテーブル抽出という名称のクエリを作って下さい。
No.1に記載しましたが、No.4に記載しなかったので、この二つが作成されていないのではと思います。
クエリデザインのSQLビューで、上記二つのSQLをそれぞれ張り付けて、上記名称で登録して下さい。

回答No.8

psgrade

VBAエディター画面で、ツール‐参照設定を確認して下さい。
当方は、

Visual Basic For Applications
Microsoft Access 14.0 Object Library
OLE Automation
Microsoft Office 14.0 Access database engine Object Library

の順でチェックが入った状態となっています。
ここで14.0は、Access2010の場合で、Access2000の場合は、これより小さい数字のついた相当名があるはずですので、チェック行に含まれていないものがありましたら、リストを下方向にスクロールし、相当する名称の行にチェックを入れて下さい。
参照設定は、Access2000から導入されました。

お礼

お礼欄ですが、すみません。
ネットで調べてAcsess DAO3.6にチェックがないとDATEBASE変数は機能しない事がわかり、解決しました。が、テーブル１抽出が有りません。のエラーがでました。
なぜかよくわかりません。

補足

ありがとうございます。
早速確認してみたところ、
Visual Basic For Applications
Microsoft Access 9.0 Object Library
OLE Automation
Microsoft ActiveX Data Objects 2.1 Library
にチェックが有りました。
スクロールして下方にいき、
Microsoft Office 12.0 Object Libraty
にチェックを入れましたが、やはり同じ所で同じエラーが出ます。

回答No.7

psgrade

プログラム冒頭でタイプミスがありました。
If MyAnswer = vbCancel Thenを
If MyAnswer = vbNo Then
に修正して下さい。
MsgBoxでvbYesNoとしていたのに、Cancelへの対応となっていました。
また、Seekメソッドで使用する、Indexとして、テーブル1のデザインビューで、固有IDに、固有IDという名前で、Indexを作成する必要があります。
尚、テーブル部分を別データベースにおいてテーブルリンクする方法の場合、Seekメソッドは使用できなくなります。その場合、FindFirstを使用することになります。

補足

お世話になってます。
昨日やっと実行してみました。
すると、
Private Function IsExist(ByVal MyTableName As String) As Boolean
Dim i As Integer, MyDb As DAO.Database
の所で、ユーザー定義型は定義されていません。とエラーが表示されました。

作業内容は教えていただいたとおり、フォームを作ってボタンのイベントプロシージャにプログラムを貼り付けました。

ただ、Private Sub データ処理_Click()
は使えず、Private Sub データ処理_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
でした。2000と2010の違いでしょうか？

回答No.6

psgrade

No.5の続きです。

Private Function IsExist(ByVal MyTableName As String) As Boolean
Dim i As Integer, MyDb As DAO.Database

Set MyDb = CurrentDb()
IsExist = False
With MyDb
For i = 0 To .TableDefs.Count - 1
If .TableDefs(i).Name = MyTableName Then
IsExist = True
Exit For
End If
Next i
End With

End Function

お礼

プログラムありがとうございました。
土日で実行してみようと思います。
実行できるまで締め切らずこのままにしておきます。
すみません。

回答No.5

psgrade

Option Compare Database
Option Explicit

Private Sub データ処理_Click()
Dim FileName As String, TableName As String
Dim MyAnswer As Variant, MyDir As String, CountTemp As Variant

FileName = "C:\人事データ.xlsx"
TableName = "Tempテーブル"

MyDir = Dir(FileName)
If MyDir = "" Then
MsgBox FileName & "は、存在しません！" & vbCrLf & "処理をスキップします。", vbExclamation + vbOKOnly, "警告"
Exit Sub
End If
MyAnswer = vbYes
MyAnswer = MsgBox(FileName & "をインポートします。（はい/いいえ）", _
vbYesNo + vbQuestion + vbDefaultButton1, "確認")
If MyAnswer = vbCancel Then
Exit Sub
End If

If MyAnswer = vbYes Then
If IsExist(TableName) Then
DoCmd.DeleteObject acTable, TableName 'Tempテーブルがある時は、削除する。
End If
DoCmd.TransferSpreadsheet acImport, , TableName, FileName, True '人事データExcelファイルをTempテーブルとしてインポートします。

MsgBox "Excelデータをインポートしました。", vbOKOnly, "確認"
End If

'新規データの追加処理
CountTemp = DCount("*", "新規データ選択")
If CountTemp = 0 Then
MsgBox "新規追加データはありません！", vbOKOnly
Else
MsgBox CountTemp & "件追加します。", vbOKOnly
Call MyNewAdd("新規データ選択", "テーブル1")
End If

'既登録データで、漢字氏名の異なるデータを上書き更新する。
CountTemp = DCount("*", "既存データ更新選択")
If CountTemp = 0 Then
MsgBox "更新データはありません！", vbOKOnly
Else
MsgBox CountTemp & "件更新します。", vbOKOnly
Call MyUpdate("既存データ更新選択", "テーブル1")
End If

MsgBox "データ更新処理を終了しました。", vbExclamation + vbOKOnly, "確認"

End Sub

Private Sub MyNewAdd(F_DataSource As String, F_Update As String)
On Error GoTo MyNewAdd_Err
Dim MyDb As DAO.Database, Rs1 As DAO.Recordset, Rs2 As DAO.Recordset
Dim LastIDTemp As Long

LastIDTemp = CLng(Mid(DMax("固有ID", F_Update), 2)) '最大固有IDの取得

Set MyDb = CurrentDb()
Set Rs1 = MyDb.OpenRecordset(F_DataSource) '追加データのレコードセット
Set Rs2 = MyDb.OpenRecordset(F_Update) '追加対象テーブル

Rs1.MoveFirst
Do Until Rs1.EOF
LastIDTemp = LastIDTemp + 1 '番号に1を足す。
Rs2.AddNew
Rs2("固有ID") = "y" & LastIDTemp '新規固有IDを付与
Rs2("漢字氏名") = Rs1("漢字氏名")
Rs2("フリガナ") = Rs1("フリガナ")
Rs2("性別") = Rs1("性別")
Rs2("生年月日") = Rs1("生年月日")
Rs2("登録日") = Date
Rs2.Update
Rs1.MoveNext '次のレコードに移動
Loop

MyNewAdd_Exit:
Rs1.Close
Rs2.Close
MyDb.Close

Set Rs1 = Nothing
Set Rs2 = Nothing
Set MyDb = Nothing

Exit Sub

MyNewAdd_Err:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly
Resume MyNewAdd_Exit

End Sub

Private Sub MyUpdate(F_DataSource As String, F_Update As String)
On Error GoTo MyUpdate_Err
Dim MyDb As DAO.Database, Rs1 As DAO.Recordset, Rs2 As DAO.Recordset

Set MyDb = CurrentDb()
Set Rs1 = MyDb.OpenRecordset(F_DataSource) '更新元データのレコードセット
Set Rs2 = MyDb.OpenRecordset(F_Update) '更新対象のテーブル

Rs1.MoveFirst
Rs2.MoveFirst
Do Until Rs1.EOF
Rs2.Index = "固有ID"
Rs2.Seek "=", Rs1("固有ID")
If Rs2.NoMatch Then
MsgBox "一致する固有IDがありませんでした！", vbOKOnly
Rs2.MoveFirst 'Nomatch=Trueの場合、カレントレコードが無効になるので、念のため、先頭行に戻す。
Else
Rs2.Edit
Rs2("漢字氏名") = Rs1("漢字氏名")
Rs2("フリガナ") = Rs1("フリガナ")
Rs2("更新日") = Date
Rs2.Update
End If
Rs1.MoveNext '次のレコードに移動
Loop

MyUpdate_Exit:
Rs1.Close
Rs2.Close
MyDb.Close

Set Rs1 = Nothing
Set Rs2 = Nothing
Set MyDb = Nothing

Exit Sub

MyUpdate_Err:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly
Resume MyUpdate_Exit

End Sub

回答No.4

psgrade

説明しきれませんので、ご希望の処理を行うプログラムを作成致しました。
データインポート以外の部分の動作も一応確認致しました。新規、アクセスファイル作成し、テーブル、クエリ、フォーム、クラスモジュールを張り付けて、動作確認してみて下さい。

テーブル１：固有ID（テキスト型）、漢字氏名（テキスト型）、フリガナ（テキスト型）、性別（テキスト型）、生年月日（日付/時刻型）、登録日（日付/時刻型）、更新日（日付/時刻型）
Tempテーブル：漢字氏名（テキスト型）、フリガナ（テキスト型）、性別（テキスト型）、生年月日（日付/時刻型）
とします。
テーブル１の固有IDは、現在設定されていないとのことなので、No. 3で記載したように、テーブル１にIDフィールドをオートナンバー型で追加し、連番を振り、下記更新クエリで”y900000001”形式のテキスト型固有IDを設定して下さい。

固有ID更新クエリ：
UPDATE テーブル1 SET [テーブル1].固有ID = "y9" & Format([テーブル1]![ID],"00000000");

更新終了後、IDフィールドは削除頂いても結構です。
No.1で説明した新規レコード追加クエリを下記のように、選択クエリに変えます。

新規データ選択：
SELECT Tempテーブル抽出.漢字氏名, Tempテーブル抽出.[フリガナ], Tempテーブル抽出.性別, Tempテーブル抽出.生年月日
FROM Tempテーブル抽出 LEFT JOIN テーブル1抽出 ON (Tempテーブル抽出.抽出フリガナ = [テーブル1抽出].抽出フリガナ) AND (Tempテーブル抽出.性別 = [テーブル1抽出].性別) AND (Tempテーブル抽出.生年月日 = [テーブル1抽出].生年月日)
WHERE ((([テーブル1抽出].固有ID) Is Null));

また、登録済みでフリガナ下3文字と性別、生年月日が同じで、漢字氏名が異なるものを選択するクエリを下記のように作成します。一致する固有IDを取得します。

既存データ更新選択：
SELECT [テーブル1抽出].漢字氏名, [テーブル1抽出].[フリガナ], [テーブル1抽出].固有ID
FROM Tempテーブル抽出 LEFT JOIN テーブル1抽出 ON (Tempテーブル抽出.生年月日 = [テーブル1抽出].生年月日) AND (Tempテーブル抽出.性別 = [テーブル1抽出].性別) AND (Tempテーブル抽出.抽出フリガナ = [テーブル1抽出].抽出フリガナ)
WHERE ((([テーブル1抽出].固有ID) Is Not Null) AND ((IIf([テーブル1抽出]![漢字氏名]<>[Tempテーブル抽出]![漢字氏名],True,False))=True));

フォームを作成し、データ処理という名前のコマンドボタンを作成し、クリック時イベントとして、下記プログラムを張り付けてください。
元のエクセル人事データ（人事データ.xlsx）は、C:\に置くことを前提にしています。
先ず、人事データをTempテーブルという名前のテーブルにインポートします。
次に、このデータから、未登録データを選択し、このデータを先頭から順次、固有IDを付与しながら、新規登録します。登録日が記録されます。
次に、登録済みで更新対象となるデータを、相当する固有IDで検索して、上書き更新します。更新日が記録されます。

プログラムは、4000字を超えたので、次の回答に入れます。

回答No.3

psgrade

既存の[名簿]アクセステーブルに固有IDがないとのことですが、なければ、テーブルデザインで、新たに仮の固有のIDフィールドをオートナンバー型で追加すればいいと思います。いずれにしてもレコードを一意に区別できる主キーは必要ですので。
オートナンバー型で新たにフィールドを追加すると、長整数型の連番が振られます。
これを元に、新たに追加した固有IDフィールドに、"y9" & Format([テーブル1].[ID],"00000000")の式を設定した、更新クエリを作成して、固有IDフィールドを更新すれば、お望みの形式の固有IDフィールドを作ることも出来ます。必要ないなら、固有ID更新後、仮に作成したオートナンバー型のIDフィールドは、削除し、固有IDフィールドを主キーとして使用することになります。

No.2で記載した、固有IDの新規作成の式が間違っていました。
"y9"に、1を加えた連番を結合する下記式となります。

"y9" & (Val(Mid(DMax("固有ID","テーブル1"),3)) + 1)

しかし、複数のレコードを一括追加する、追加クエリで、それぞれに固有IDを新規付与する方法はここでは、説明できませんので、やはり、オートナンバー型でAccessに自動付与させる方が格段に簡単です。

尚、オートナンバー型のフィールドを持つテーブルを複数ユーザー環境でレコード追加すると、連番ではなく乱数となりますので注意して下さい。

補足

いつもありがとうござます。
私の最初の質問の仕方が悪かったです。

毎年、固有ＩＤを作る業務をしたいのですが、貰える名簿はＩＤは無し、氏名、フリガナ、性別、生年月日の情報をもらえます。
しかし、新規も含め、全員分のデータをもらうので、すでにＩＤを登録している人なら既存のＩＤ（昨年こちらで作ったもの）をつかい、改姓などあれば修正する、未登録の人なら新規ＩＤを割り当て登録する。という作業をしたいのです。

なので、すでに登録している人かどうかの判定をまず、生年月日、性別、フリガナ後尾３文字くらいで判定する。
（生年月日、性別は同じ人がいると思います。もし、結婚して苗字が変わっていたりすると、フリガナで判定できないので後ろ３文字くらいが適当？と思い、それを利用して未登録者かどうか判定したらいいのではないか？と自分なりに思っています。）

やりたい作業内容がわかってもらえたでしょうか？
これまで教えていただいたことは上手くできていますが、私の質問が悪く、やりたいことができていないです。

すみません。宜しくお願いします。

回答No.2

psgrade

No.1です。

固有IDは別に付与ということで、追加クエリを書き換えました。

新規データ追加：
INSERT INTO テーブル1 ( 漢字氏名, フリガナ, 性別, 生年月日 )
SELECT Tempテーブル抽出.漢字氏名, Tempテーブル抽出.[フリガナ], Tempテーブル抽出.性別, Tempテーブル抽出.生年月日
FROM Tempテーブル抽出 LEFT JOIN テーブル1抽出 ON (Tempテーブル抽出.生年月日 = [テーブル1抽出].生年月日) AND (Tempテーブル抽出.性別 = [テーブル1抽出].性別) AND (Tempテーブル抽出.抽出フリガナ = [テーブル1抽出].抽出フリガナ)
WHERE ((([テーブル1抽出].固有ID) Is Null));

IDは、コンピューター内での処理の主キーですので、オートナンバー型にして、Accessに自動付与させるのが一番楽です。私は、もっぱらそのようにしています。オートナンバー型なら、固有ID以外のデータを追加すると、自動的に固有IDが長整数として割り振られます。
自分で自動的に付与するとすると、最大の既存固有IDの2文字以降をMid関数で取出し、これをVal関数を用いて文字を数値に変化し、1を加え、これに先頭につけるアルファベットを付けるという以下のような操作を行う必要があります。

Left(([テーブル1].[固有ID],1) & (Val(Mid(DMax("固有ID","テーブル1"),2)) + 1)

但し、これは、先頭に付けるアルファベットがすべて同じ場合です。アルファベットが異なる場合、事前に先頭のアルファベットを除いた固有IDを作成するクエリを作成し、DMax処理することになります。これに1を加え、InputBox関数等で指定させたアルファベットを結合させるという操作になります。VBAを十分使いこなせることが必要になります。
固有IDは、レコードの識別のみで使用し、他に分類や、ソートしたい項目があるのであれば、別にフィールドを設ける方が処理しやすいと思います。

補足

ありがとうございます。新規ＩＤの自動付与は頭につけるアルファベットはすべてｙで同じにしようと思っています。

最初の回答で頂いたleftjoinですが、固有ＩＤが無いので、使えないです。

現在アクセスに去年の名簿が有りますが、新しく貰う名簿には既存社員、新入社員混ざっています（固有ＩＤは名簿に入っていません。）。そこで、全データをインポートして生年月日、性別、カナ後ろ３文字で重複クエリを作成し、同一人物かどうか判断する。同一人物なら、新しいデータで上書き（ＩＤは前のものを使うが改姓など）新入社員なら新規登録、ＩＤ付与をしたらいいのでは、と思っていますが上手くいきません。

回答No.1

psgrade

Left　Joinを用いて、エクセルから取り込んだテーブルの全レコードとこれと一致する既存テーブルのレコードを抽出させ、既存テーブル側の固有IDがNullのものを選択します。これが未登録のレコードの集合となるので、これを追加します。逆に固有IDがNullでないものは、登録済みデータで、エクセル側データと一致するレコードなので、これは、更新させるデータとなります。この考えで、処理すると以下のようになります。

テーブル1に固有ID、漢字氏名、フリガナ、性別、生年月日フィールドを作り、エクセルから取り込んだテーブルをTempテーブルでテーブル1と同じ名前のフィールド構成とします。
この２つのテーブルに対し、それぞれ次のSQL文のクエリーを作成します。

テーブル1抽出：
SELECT [テーブル1].固有ID, [テーブル1].漢字氏名, [テーブル1].[フリガナ], Right([フリガナ],3) AS 抽出フリガナ, [テーブル1].性別, [テーブル1].生年月日
FROM テーブル1;

Right関数で比較する為の、フリガナの後ろ3文字を抽出して、比較できるようにしています。次のクエリーでも同様です。

Tempテーブル抽出：
SELECT Tempテーブル.固有ID, Tempテーブル.漢字氏名, Tempテーブル.[フリガナ], Right([フリガナ],3) AS 抽出フリガナ, Tempテーブル.性別, Tempテーブル.生年月日
FROM Tempテーブル;

この2つのクエリー(テーブル1抽出、Tempテーブル抽出)を元に次の追加クエリーを作成します。

新規データ追加：
INSERT INTO テーブル1 ( 固有ID, 性別, 生年月日, 固有ID )
SELECT Tempテーブル抽出.固有ID, Tempテーブル抽出.性別, Tempテーブル抽出.生年月日, [テーブル1抽出].固有ID
FROM Tempテーブル抽出 LEFT JOIN テーブル1抽出 ON (Tempテーブル抽出.生年月日 = [テーブル1抽出].生年月日) AND (Tempテーブル抽出.性別 = [テーブル1抽出].性別) AND (Tempテーブル抽出.抽出フリガナ = [テーブル1抽出].抽出フリガナ)
WHERE ((([テーブル1抽出].固有ID) Is Null));

これで未登録の新規レコードのみが追加されます。
登録済みのレコードの漢字指名、フリガナを更新するクエリーは次のようになります。
既存データ更新：
UPDATE Tempテーブル抽出 LEFT JOIN テーブル1抽出 ON (Tempテーブル抽出.生年月日 = [テーブル1抽出].生年月日) AND (Tempテーブル抽出.性別 = [テーブル1抽出].性別) AND (Tempテーブル抽出.抽出フリガナ = [テーブル1抽出].抽出フリガナ) SET [テーブル1抽出].漢字氏名 = [Tempテーブル抽出]![漢字氏名], [テーブル1抽出].[フリガナ] = [Tempテーブル抽出]![フリガナ]
WHERE ((([テーブル1抽出].固有ID) Is Not Null));

新規クエリー作成画面で、SQLビューに切り替えて、上記SQL文を張り付けて、デザインビューに切り替えて、クエリー内容を確認して下さい。
こちらは、Access2010ですが、2000でも同じですので確認して下さい。

お礼

お礼欄ですが、すみません。補足に書き忘れたので・・・
質問に間違いが有りました。
固有ＩＤはこちらで割り付けるので、エクセルでインポートするデータにはＩＤはありません。
ですから、生年月日、性別、フリガナ後ろ３文字で同一人物かどうか判定したいです。同一人物ならば、既存のＩＤを割り付け、新入社員なら新たにＩＤを割り付ける。という作業がしたいです。
質問内容に不備が有りすみません。

補足

ありがとうございます。
難しそうですが、なるべく早く実行してみようと思いますので、検証できるまでしばらく質問はおいておきます。
新規ＩＤ自動振り付けはどうしたらよいでしょうか？