• ベストアンサー

アクセス2002 新番号割当とテーブルのデータ追加

教えてください。 フォーム内にあるボタンに以下のイベントプロシージャーが入っています。 このボタンで行いたいことは、 1.フォーム内に「入力したデータ」に新しい「番号」(PS-0000001から始まり、1ずつ増える)をつけ、 2.abcdeのテーブルに、「入力したデータ」と「番号」を書き込む ========イベント======= Dim DB As Database Dim ts As DAO.Recordset Set DB = CurrentDb() Set ts = DB.OpenRecordset("T_abcde", dbOpenDynaset) If ts.EOF Then txtFileNo = "PS-0000001" Else ts.MoveLast txtFileNo = "PS-" & Format(ts!No + 1, "0000000") End If ts.Close DB.Close ===イベントここまで=== フォームにデータを入れて2回まではうまくできるのですが、3回目以降は番号は更新されずabcdeへのデータもどんどん上書きされてしまいます。 意味通じましたでしょうか? よろしくお願いいたします。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

はじめまして。 ts.MoveLastのところを、 ts.Addnewにして、 txtFileNo = "PS-" & Format(ts!No + 1, "0000000") の後に、ts.Update を追加してみてください。 自信はありませんが^^;

Swim
質問者

お礼

早速の回答ありがとうございます。 番号は加算されるのですが、ときどき2加算されたり、またabcdeへのデータも画面を開いたとき最初に入力したものだけでした。 参考にして、修正してみたいと思います。

Swim
質問者

補足

ごめんなさい。別にプログラムミス発見。リストに表示できていました。ありがとうございました!

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (1)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

Private Sub コマンド0_Click() Dim db As DAO.Database Dim ts As DAO.Recordset Set db = CurrentDb() Set ts = db.OpenRecordset("名簿1", dbOpenDynaset) ts.MoveFirst n = ts!番号 MsgBox n p01: ts.MoveNext If ts.EOF Then m = Mid(n, 4, 7) MsgBox m ts.AddNew ts!番号 = "PS-" & Format(Val(m) + 1, "0000000") MsgBox ts!番号 ts.Update GoTo p02 Else n = ts!番号 MsgBox n GoTo p01 End If '----- p02: ts.Close db.Close End Sub ----------- 試行錯誤したのでMsgBoxが入っていますが省いてください。 AddNew,Updateが要るのではないですか。それに番号をテキスト型にしたので、+1するにはVal()が必要でしょう。2002でテスト済み。 AddNewのあとはts.Editは不要のようです。

Swim
質問者

お礼

いろいろテストしていただいたようで、ありがとうございました。 番号は加算されるのですが、リストにどうしても追加されず、もう少し頑張ってみます。

Swim
質問者

補足

ごめんなさい。別プログラムにミスがありました。 これで完璧です。ありがとうございました!

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • ACCESS どこがおかしいのか?

    ACCESSで。クエリからフォームを作成し、検索フォームを作成しようとしています。 AND条件とOR条件を作り検索(抽出)を行いたいのですが、何が間違っているのか、 検索をかけるとすべて「登録がありません」になってしまいます。 どこが間違っているのか、もしくは代替案を教えていただけますでしょうか。 以下は記述した、VBAコードです。 Private Sub 検索ボタン_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Dim stFil As String Set db = CurrentDb() Set rs = db.OpenRecordset("Q_Autoweb", dbOpenDynaset) 'オプションボタンで条件を選択 If 検索条件 = 1 Then rs.Filter = "[タイトル]='" & タイトル検索 & "' and [本文]='" & テキスト15 & "'" Else rs.Filter = "[タイトル]='" & タイトル検索 & "' or [本文]='" & テキスト15 & "'" End If Set rs = rs.OpenRecordset Set Me.Recordset = rs If rs.EOF = True Then MsgBox "登録がありません" Else Me.ID = rs!ID Me.案件名 = rs!案件名 Me.タイトル = rs!タイトル Me.本文 = rs!本文 End If rs.Close Set rs = Nothing db.Close Set db = Nothing End Sub よろしくお願いします。

  • ACCESSの SELECT SUM

    SELECT SUMを 計算させると ゼロしか 出てきません。 どこが悪いのでしょうか?  日付         出金       氏名 2012/12/10      540      安田 2012/12/10      1020      斉藤 2012/12/10       970      TOM 2012/12/11      650      池田  2012/12/11     2010      南 2012/12/12      350      林田 2012/12/12     1200      加藤 のようなテーブルがあり Private Sub コマンド_click() Dim Db As Database Dim SQL As String Dim rs As Recordset Dim gokei As Long Set Db = CurrentDb SQL = "SELECT Sum(出金) as gokei FROM テーブル  WHERE 日付= #" & [Forms]![フォームアルファ]![テキスト] & "# " Set rs = Db.OpenRecordset(SQL) MsgBox gokei End Sub を フォームアルファに 新しく作ったコマンドボタンのクリック時に 書きました。 これを テキストの日付を変えておいて いろいろ試しても ゼロのメッセージしか出ません。 WHERE以下が 間違っていないか 試しに Private Sub コマンド_click() Dim Db As Database Dim SQL As String Dim rs As Recordset Dim Count As Long Set Db = CurrentDb SQL = "SELECT (出金)  FROM テーブル  WHERE 日付= #" & [Forms]![フォームアルファ]![テキスト] & "# " Set rs = Db.OpenRecordset(SQL) If rs.EOF Then Count = 0 Else rs.MoveLast Count = rs.RecordCount End If MsgBox Count End Sub を 実行すると ちゃんと 正しいレコード数が 表示されます。 「出金」のデータ型は 長整数になっています。 どこが 悪いのでしょうか? 目的は 指定した日付の 出金の合計を取り出したいのです。 . . .

  • 【Access】 郵便番号を検索するシステム

    よろしくお願いいたします。 現在、Accessのフォームにて、任意の番号をテキストボックス("(1)")に入力し"検索ボタン"を押すと、該当する郵便番号がフォーム上のテキストボックス("(2)")に表示されるシステムを作っています。 また、郵便番号は"郵便番号一覧"というテーブルにまとめています。 (テーブルには約14万件の"郵便番号"と"住所"が含まれています) ここで質問があるのですが、同じ郵便番号であっても複数の住所が該当するケースがあります。 テーブルにもそうした件が多数含まれていますが、現在の私のVBAでは、その内のひとつの住所しか表示することが出来ません。 そこで、複数の住所が存在する場合は、該当する住所の一覧が表示され、その中から1件を選べるようなシステムを作りたく考えています。 様々な参考書を読み続けてきましたが、完全に行き詰まりました。お知恵を拝借頂けますと幸いです。 -------------------------------- 尚、現在のVBAは下記の通りです。 Private Sub 検索ボタン_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("郵便番号一覧", dbOpenTable) With rs .Index = "郵便番号" .Seek "=", Me.(1) End With If Not rs.NoMatch Then With Me .(2) = rs!住所 End With End If rs.Close: Set rs = Nothing db.Close: Set db = Nothing End Sub

  • アクセス テーブルデータ他のテーブルにコピーVBA

    win10 access365のmdbファイルにおいて table1のフィールド1がID 数値型 長整数型 値要求あり 重複あり フィールド2が氏名 短いテキスト型 225 値要求なし 重複あり  table2;フィールド1がID 数値型 長整数型 値要求あり 重複あり フィールド2が氏名 短いテキスト型 225 値要求なし 重複あり  上記に置いて table2の新しいデータとして table1のデータをコピーしたい、 ただしtable1には レコードは1行だけとします (table1にレコードが複数行ある場合の最新レコードだけtable2にコピーも出来れば知りたいです) アクセス付属の更新クエリーでは、どうも うまくいきません sqlにおいて UPDATE table1, table2 SET table2.ID = [table1]![ID], table2.氏名 = [table1]![氏名]; 上記動作しません Function table1から2() Dim db As DAO.Database Dim rst As Recordset Dim TB As Table Dim Rdset As Recordset On Error Resume Next Set db = DBEngine(0)(0) Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE) Rdset.AddNew Rdset![ID] = Table![table1]![ID] Rdset![氏名] = Table![table1]![氏名] Rdset.Update End Function table1, table2を それぞれ 同名のフォームを作り Function table1から2() Dim db As DAO.Database Dim rst As Recordset Dim fm As Form Dim Rdset As Recordset On Error Resume Next Set db = DBEngine(0)(0) Set fm = Forms![table1] If Rdset.BOF Then Exit Function Else Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE) Rdset.AddNew Rdset![ID] = Forms![table1]![ID] Rdset![氏名] = Forms![table1]![氏名] Rdset.Update End If End Function いずれも table2のデータ更新が なされていません すみません 宜しくお願い致します

  • SQLSERVERからデータを取得する方法

    SQLSERVERに商品テーブルを作り ACCESSにローカルテーブル(下記の例では入力テーブル)を 作りました。 ACCESS VBAで ACCESSのローカルテーブルを1件ずつ読み SQLSERVERの商品テーブルを検索したいのですが 下記の例 どちらが処理スピードが速いのですか? なお下記以外にも処理スピードが速い方法が あったら教えてください。 ●例1 Dim db As DATABASE Dim rs As Recordset   dim rt as Recordset Set db = CurrentDb Set rt = db.OpenRecordset("入力テーブル", dbOpenDynaset) sql = "SELECT 商品名 FROM 商品テーブル " sql = sql & "where 商品ID = '" & rt![商品ID] & "'" Set rs = db.OpenRecordset(sql) If rs.RecordCount = 0 Then MsgBox "NG" Else MsgBox rs![商品名] End If ●例2 Dim db As DATABASE Dim rs As Recordset   dim rt as Recordset Set db = CurrentDb Set rt = db.OpenRecordset("入力テーブル", dbOpenDynaset) Set rs = db.OpenRecordset("商品テーブル", dbOpenDynaset) rs.FindFirst "商品CD = '" & rt![商品CD] & "'" If rs.NoMatch Then MsgBox "NG" Else MsgBox rs![商品名] End If よろしくお願いします。

  • ループで呼び出しながら、追加クエリでテーブルに追加

    IDをループで呼び出しながら、追加クエリでテーブルに追加したいのですが、 値が入りません。 エラーなく動くのですが、テーブルに値が入っていないのです。 何がたりないのでしょうか? ――――――――――――― Public Sub CYUSYUTU_SEIKYUID2() Dim CYUSYUTU_SEIKYUID As String Dim recCount As Long recCount = DCount("*", "作業用請求先ID") Dim ID As String Dim DB As DAO.Database Dim RS As DAO.Recordset Dim i As Integer Dim strSQL As String Set DB = CurrentDb Set RS = DB.OpenRecordset("作業用請求先ID") RS.MoveFirst Do Until RS.EOF RS.Edit For i = 1 To recCount CYUSYUTU_SEIKYUID = RS.Fields("請求先ID(13)").Value DoCmd.RunSQL _ "INSERT INTO [作業用_▲入金DB] SELECT * FROM ▲入金 WHERE ▲入金.請求先ID='& CYUSYUTU_SEIKYUID &';" Next i RS.Update RS.MoveNext Loop RS.Close: Set RS = Nothing DB.Close: Set DB = Nothing End Sub

  • access2003 自社カレンダーを作りたい

    現在、access2003で注文書を出力するプログラムを作成中です。 自社の営業日カレンダーを表示させたいのですが、 開く時のイベントプロシージャでエラーになって先に進みません。 エラーメッセージは 【イベントプロパティに指定した式 開く時でエラーが発生しました:プロシージャの宣言が、イベントまたはプロシージャの定義と一致していません。】です。 開発が初めてなので、どなたか教えていただけませんか?よろしくお願いします。   下記のイベントプロシージャの書き方に問題がありますか?  Function Form_Open(F As Form) Dim DB As DAO.Database Dim rs As DAO.Recordset Dim F As Form Set DB = CurrentDb Set F = Forms!カレンダA Set rs = DB.OpenRecordset("calen", dbOpenDynaset) End Function

  • アクセスVBAです

    Sub test() Dim DB As Database Dim T As TableDef Dim myTable As String myTable = "Table1" Set DB = OpenDatabase(CurrentProject.FullName) For Each T In DB.TableDefs If T.Name = myTable Then DoCmd.DeleteObject acTable, myTable Exit For End If Next DB.Close Set DB = Nothing End Sub これを実行しようとすると Dim DB As Database の部分で コンパイルエラー プロジェクトではなく、ユーザ定義型を指定してください。 と言うエラーになります。 Dim DB As Objectにすればエラーにならずに進みますが 何が原因なのでしょうか?

  • 同じテーブルのフィールドを使ったUPDATEしたい

    こんにちは。 いつも参考にさせていただいています。 本日は投稿側です。 やりたいことは「T_ALL」テーブルの加工した「受付番号」フィールドを 「お客様番号」フィールドに書き込むことです。 ACCESS VBAで以下のコードを書き、実行すると[受付番号]のとこで 「定義されていない」とエラーになります。 思考錯誤しましたが解決できず困っています。 ご教示ください。 よろしくお願いします。 ************************************************************************* Dim db As ADODB.Connection Dim rs As ADODB.Recordset Dim mypath, we As String Dim mysql As String Set db = New ADODB.Connection Set rs = New ADODB.Recordset db.Open "Provider=OraOLEDB.Oracle;Data Source=kcwf;User Id=kcwf;Password=kcwf;" rs.Open "SELECT * FROM T_ALL", db, adOpenDynamic, adLockOptimistic, adCmdText '***** 項目を更新 mysql = "UPDATE T_ALL SET お客様番号= 'B" & Mid([受付番号], 5, 9) & "'" db.Execute mysql 'Close rs.Close Set rs = Nothing db.Close Set db = Nothing *************************************************************************

  • Access 2000 の VB での テーブル作成について質問です。

    下記のようにAccess 2000のVBからDAOを使ってテーブルを作っておりますが、 作るフィールドに規定値の設定もVBからできないのでしょうか?DAOだと無理なのでしょぅか? 教えてください Dim db As DAO.Database Dim tbdef As DAO.TableDef Dim flID As DAO.Field Set db = CurrentDb Set tbdef = db.CreateTableDef("テーブル") Set flID = tbdef.CreateField("ID", dbInteger)   tbdef.Fields.Append flID   db.TableDefs.Append tbdef db.Close: Set db = Nothing

専門家に質問してみよう