Microsoft Accessで自動採番をさせたい。

質問

いつも大変お世話になっております。
アクセスでの質問です。

フィールドに「管理ID」があって、ここに８ケタのコードが自動採番されるようなしくみにしたいと考えています。
この管理IDは８ケタで、採番の仕組みは以下の通りです。

(1)「アイテム分類」というフィールドに入った製品によって頭２桁が決まる。
例）野菜・・・YA
　　果物・・・KU
　　鮮魚・・・SE

(2)入力しているのが06年07月だったら次の４桁は「0607」になる。

ここまでで、頭の６ケタ「YA0607」などまでが決まる。

最後の２桁は、その月に発生している情報の連番をつけていきたい。

例）
06年07月に１番目に採番されたデータ→YA060701
06年07月に５番目に採番されたデータ→YA060705

という具合に・・・

これにはたくさんの要素がつまっています。

要素(1)　採番するフィールド以外のフィールド（アイテム分類)を見て、頭２文字を決めること。（ただし、規則はありますので、ＤＢで表すことはできます）

要素(2)　現在のDATEから、年と月だけ４桁拾うこと

要素(3)　過去に発生しているレコードを抽出・カウントし、最後の数字の+1になる番号をつける

ということです。
上記のようなことが可能なのでしょうか？

分かりましたら、できるだけ具体的に教えてください。よろしくお願いします。m(＿ ＿)m

回答No.2

nicotinism

連番を求めるためには、フォーム上での処理と仮定して
標準モジュール（フォームのモジュールではありません）に

Function getNo(strBunruiNo As String, strHidukeNo As String) As String
'管理ID採番
Dim strTmpNo As string

strTmpNo = DMax("mid(管理ID,7)", "テーブル名は実際の名前で", _
"left(管理ID,6)='" & strBunruiNo & strHidukeNo)

If Val(strTmpNo) >99 then
getNo = "桁数超過"
exit function
End If

getNo = strBunruiNo & strHidukeNo & Format(Val(strTmpNo) + 1, "00")
End Function

としときます。
これで、イミディエイトウィンドウで
?getno("ya","0609")
で ya060905 等と求められるかと思います。

この後はどのようなインターフェースにするかに掛かってきますので一案として
フォームに、
「アイテム分類」 → strBunruiNo
「年月」 → strHidukeNo
とそれぞれ対応するテキストボックスを作成して
コマンドボタンのクリック時とかのイベントに適当に・・。

あるいはレコード移動時に
Private Sub Form_Current()
　　If Me.NewRecord Then
　　　　Me!管理ID = getNo(Me!アイテム分類,Me!年月)
　　End If
End Sub

で求められるとは思います・・・が・・・　(^^ゞ

お礼

回答ありがとうございました。
お礼のお返事が遅くなってすみません。

上記、挑戦してみます。
不明な点は再度補足にて質問させていただきます。

回答No.1

noname#22222

可能なことは可能ですが・・・。
主キーに色んな意味を持たせるのは20年前の発想かと思います。
通常は、採番テーブルを参照してカウントアップするだけかと・・・。

*****

さて、本題ですが、それぞれは基本中の基本のコードで実現できます。
まあ、最大値を抜き出す部分が問題かと思います。
なぜなら、DMAX関数を利用すると処理速度に問題があるからです。
そこで、DBMAX関数だけ紹介しておきます。

strMaxID=DBMax("ID", "XXXXX", "YYYYYYYY")

後は、カウンタ部分を抽出して＋１して合成すればいいです。

Public Function DBMax(ByVal strField As String, _
　　　　　　　　　　　ByVal strTable As String, _
　　　　　　　　　　　Optional strWhere As String = "") As Variant
On Error GoTo Err_DBMax
　　Dim N
　　Dim strQuerySQL As String
　　Dim rst　　　　 As ADODB.Recordset

　　Set rst = New ADODB.Recordset
　　strQuerySQL = "SELECT MAX(" & strField & ") FROM " & strTable
　　If Len(strWhere) > 0 Then
　　　　strQuerySQL = strQuerySQL & " WHERE " & strWhere
　　End If
　　With rst
　　　　 .Open strQuerySQL, _
　　　　　　　 CurrentProject.Connection, _
　　　　　　　 adOpenStatic, _
　　　　　　　 adLockReadOnly
　　　　 If Not .BOF Then
　　　　　　 .MoveFirst
　　　　　　 N = Nz(.Fields(0), 0)
　　　　 End If
　　End With
Exit_DBMax:
On Error Resume Next
　　 rst.Close
　　 Set rst = Nothing
　　 DBMax = N
　　 Exit Function
Err_DBMax:
　　 MsgBox "SELECT 文の実行時にエラーが発生しました。(DBMax)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBMax
End Function

※なお、各ステップが皆目ならば、中途までの自前コードを示して判らない部分のみを聞いたがいいです。

お礼

回答ありがとうございました。
早速挑戦してみます。
分からない部分がありましたら、的確に再質問させていただきます。
よろしくお願いします。