- ベストアンサー
ACCESS VBAのMoveメソッドがおかしいのでは？
ACCESS2000のVBA、Moveがおかしいです。 "通番"(数値型)フィールドを持つ"テーブル1"に、レコード通番を埋め込む(更新)というプログラムです。 事情があって10レコード毎に処理を繰り返すのですが、レコード数が501の場合に実行時エラー'3021'になります。502や500レコードの場合は問題無し。 どうやら、moveで501レコード目に飛んで最終行だった場合、EOFがTrueになってしまっているようです（EOFは次の行なのに）。 Public Function koshin() Const bunkatsu = 10 '１処理の区切りとなるレコード数 Dim rcd As New ADODB.Recordset Dim no As Long '処理用内部変数 Dim recno As Long 'テーブルのレコード数 Dim rep As Long '処理の繰り返し数 rcd.Open "テーブル1", CurrentProject.Connection, adOpenKeyset, adLockPessimistic recno = rcd.RecordCount 'レコード数を取得する rcd.Close MsgBox "レコード数は" & recno & "です" no = 0 rep = -Int(-(recno / bunkatsu)) '分割回数を算出する MsgBox "内部処理を" & rep & "回分割して行います" For i = 0 To rep - 1 rcd.Open "テーブル1", CurrentProject.Connection, adOpenKeyset, adLockPessimistic rcd.Move i * bunkatsu For j = 1 To bunkatsu no = no + 1 rcd![通番].Value = no rcd.Update rcd.MoveNext If rcd.EOF Then Exit For Next j rcd.Close SysCmd acSysCmdSetStatus, no & "件処理しました" Next i MsgBox "終了しました" End Function
- その他(データベース)
- 回答数3
- ありがとう数0
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (2)
関連するQ&A
- ACCESSのVBAで
Dim rcd As New ADODB.Recordset Sql = "SELECT * FROM 社員テーブル" rcd.Open Sql, CurrentProject.Connection If rcd.EOF Then Else 社員コード = rcd!社員コード 社員名称 = rcd!社員名称 end if のような記述で、Sqlのところをテーブルからのselectではなくクエリからデータの取得って出来るのでしょうか？(sqlのところがクエリ名になる) よろしくお願いします。
- 締切済み
- その他(データベース)
- アクセスVBAの検索メソッドについてデバック
前回もこちらで質問させていただいたことがある内容なのですが、引き続き、トラブルに悩まされています。仕組みがおかしくなっていたので、自分で触ってしまったことがまた悪影響だったのですが、、。 元々他の人が作ったものであり、いま、うまくいかない原因を探っているところです。まず、添付のシートにあるように、上の行のテーブルデータは"商品２_T"という名前のテーブル、下のデータは"商品２_T25discount"という名前のテーブルです。それぞれデータを引っ張ってきて、こちらのサイトに投稿するために貼り付けしました。 問題のコードをこちらに記載します。 Dim cn As ADODB.Connection Dim cn2 As ADODB.Connection Dim rs As ADODB.Recordset Dim rs2 As ADODB.Recordset Dim strmsg As String Dim lngRet As Long Dim strcriteria As String Set cn = CurrentProject.Connection Set rs = New ADODB.Recordset Set cn2 = CurrentProject.Connection Set rs2 = New ADODB.Recordset rs.Open "商品２_T", cn, adOpenKeyset, adLockOptimistic rs2.Open "商品２_T25discount", cn2, adOpenKeyset, adLockOptimistic MsgBox "更新を開始します ", 64, 更新 Do Until rs.EOF '該当レコード摘出 If rs!MCD = Me!tx検索 Then '--------------------------------------------- strcriteria = "CAT = '" & rs!CAT & "'" ' --- A rs2.Find strcriteria, 0, adSearchForward If rs2.EOF Then ' Else rs!仕入単価 = rs2!discount End If '--------------------------------------------- rs!更新日 = Now() rs.Update End If rs.MoveNext Loop MsgBox "更新が完了しました ", 64, 更新 （以上） やりたいことの説明ですが、まず、 If rs!MCD = Me!tx検索 Then とあるように、これはフォーム内にテキストボックスを用意していますので、ここに記入したMCDに一致するものに、検索をかける、ということです。そしてつぎに、strcriteria = "CAT = '" & rs!CAT & "'" 、（省略）rs!仕入単価 = rs2!discount とありますように、"CAT"を検索対象にし、前者のテーブルの"仕入単価"を、後者のテーブルの"discount"のデータで塗り替えます。 という私の解釈なのですが、（何せ他の人が作りましたので）正しいですよね？ それで今試しているところなのですが、なぜかうまくいきません。何が間違っているのでしょうか？ どういうエラーになるのかというと、これを実行すると、"更新日"というフィールドのみ、更新されて、仕入単価はそのままになります。ちなみに更新日が更新されているのは、このテキストボックスに入れたMCDが一致する全てのデータに対してですので、MCDが一致、には反応しているが、CATを検索して更新をかける、という動作に失敗しているように見えます。 しかし素人なのでこれ以上どうすればよいかがわかりません。どなたか少しでも解決策があれば教えていただけないでしょうか。
- 締切済み
- Visual Basic
- ACCESSでレコード数の取得の仕方
Ａテーブルのレコード数を取得しようと思い、次のＰＧを考えました。（Ａテーブルには１０件のデータが入っています。）ですが、「－１」という数値が返ってきます。なぜでしょうか？ Dim objADOCON As ADODB.Connection Dim objADORS As ADODB.Recordset Dim strSQL As String Set objADOCON = Application.CurrentProject.Connection strSQL = "SELECT * FROM Aテーブル" Set objADORS = objADOCON.Execute(strSQL) MsgBox objADORS.RecordCount , vbOKOnly, "レコード数"
- ベストアンサー
- その他(データベース)
- access2000VBAで、外部ファイルに書き込むには
access2000 VBAで 「sample.htmlを作成、 tableテーブルのデータを書き込む」 をして、htmlファイルを自動作成したいのですが、 うまくVBAがかけません。 とりあえず、外部ファイルにデータを出力に取り組んでいます 外部ファイルの作成の仕方と、書き込みのところで、 どうしたらいいのか分からず、困っています。 アドバイスおねがいします。<(_ _)> Dim cnc As New ADODB.Connection Dim rst As New ADODB.Recordset Set cnc = CurrentProject.Connection rst.Open "table", cnc, adOpenKeyset, adLockOptimistic, adCmdTableDirect Open sample.html For Output As #1 If rst.EOF Then MsgBox "There are not recordset" GoTo db_Close End If Do Until rst.EOF Debug.Print rst!種類, rst!名前, rst!url Write #1, rst!種類, rst!名前, rst!url rst.MoveNext Loop Close #1 db_Close: rst.Close Set rst = Nothing cnc.Close Set cnc = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- うまく処理されません（ＡＣＣＥＳＳのＶＢＡ）
イベント事業を管理するデータベースを作っています。 メインのテーブルを表示するフォームから、チェック（Yes/No型）された項目だけを抽出したクエリ「記事抽出」があります。 ここから、「行事名」「会場」「月１」「日１」という各フィールドのデータを以下のコードのように変数に代入していきたいのです。 チェックした数が少ないときはうまくいくのですが、２０個くらいチェックすると、ループの途中で抜けてしまいます。このとき、エラーメッセージは表示されません。 原因として考えられることがあればお教えください。 説明が不足しているようでしたら、補足のほうで説明したいと思いますのでよろしくお願いします。 Dim cnn As New ADODB.Connection Dim rst As New ADODB.Recordset Dim i As Integer Dim gyouji(50) As String '行事名 Dim kaijyou(50) As String '会場 Dim tuki1(50) As Integer '月１ Dim nichi1(50) As Integer '日１ Set cnn = CurrentProject.Connection i = 0 With rst .Open "記事抽出", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect Do Until .EOF gyouji(i) = !行事名 kaijyou(i) = !会場 If IsNull(!月１) Then tuki1(i) = 0 Else tuki1(i) = !月１ End If If IsNull(!日１) Then nichi1(i) = 0 Else nichi1(i) = !日１ End If .MoveNext i = i + 1 Loop .Close End With cnn.Close
- ベストアンサー
- オフィス系ソフト
- Access EOFの判定がうまくいかない
お世話になります。 Access2010 テーブルのEOFの判定がうまくいきません。 If TMP.EOF = False Then MsgBox "EOFではありません" Else MsgBox "EOFです" End If TMPには1レコードありますが、なぜかTrueになってしまいます。 なお、TMP.MoveLastしてもエラーにならず、その後、イミディエイト ウィンドウで？TMP.EOFとしてみると、Falseが返ってきます。 本来であればEOFでMoveLastするとカレントレコードが無い旨のエラーに なるかと思うので、EOFではないと思うのですが。。 どのようなことが考えられますでしょうか。 ＜TMPについて＞ ・(訳あって)主キーは設けておりません。 ・0レコードか1レコードです。1レコード以上になることはありません。 ・TMPはあるフォームのレコードソースとしています。 ※フォーム上の登録ボタンが押されたら、フォームのレコードソースを ""としフォームを閉じます。このタイミングでTMPにレコードが生成 されます。 上記の判定処理は、フォームを閉じた直後に行っています。 ご教示の程、宜しくお願い致します。
- 締切済み
- その他MS Office製品
- アクセスＶＢＡ 変数での抽出条件の書きかた
顧客データテーブルからの抽出です。 変数を使った書き方がわかりません。 よろしくお願いします。 テーブルのレコードには [氏名]：鈴木 [telnum]：0123456789 が存在します。 Private Sub テキスト0_BeforeUpdate(Cancel As Integer) Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("顧客マスタ", dbOpenDynaset) Dim str As String str = "0123456789" rs.Filter = "[telnum] = ' " & str & " ' " Set rs = rs.OpenRecordset MsgBox (rs!氏名) ’←エラーメッセージ”カレントレコードがありません。”が出ます End Sub
- 締切済み
- オフィス系ソフト
- accessについて＜ＢＯＦとＥＯＦのいずれかがＴＵＲＥになっているか・・・現在のレコードが必要です＞
Private Sub kensaku_Click() On Error GoTo Err_kensaku_Click Screen.PreviousControl.SetFocus Dim ss As String Dim rs As String Dim strSQL As String Dim rstType As ADODB.Recordset Set rstType = New ADODB.Recordset ss = text.text strSQL = "Select 見積日 From 見積 where 提出見積No ='" & ss & "'" rstType.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdText If ss = "" Then MsgBox ("提出見積Noを入力してください") ElseIf rstType.EOF = False Then While rstType.EOF = False rs = rstType.GetString MsgBox (rs) rstType.MoveNext Wend kikaiNo.Value = "222" Else MsgBox ("提出見積Noが存在しません") End If Exit_kensaku_Click: Exit Sub Err_kensaku_Click: MsgBox Err.Description Resume Exit_kensaku_Click End Sub 以上は書いた検索のコードですが、＜ＢＯＦとＥＯＦのいずれかがＴＵＲＥになっているか、または現在のレコードが削除されています。要求された操作には、現在のレコードが必要です＞というエラーが出てきます。問題がどうかよくわかりませんので、教えていただけませんか。
- 締切済み
- その他(データベース)
- アクセスＶＢＡ 初心者 レコードの削除
アクセス初心者 ＶＢＡに初挑戦です。 何度もこちらで助けていただき、あと一歩のところまできましたが、またつまづきました。 教えてください。 有給休暇の年次更新プログラムを作成中です。 一連の更新計算処理を行ったあと、サブフォームに入力すみの、消化履歴レコードをテーブルから削除する部分を作っています。 テーブルは、 社員コード、年月日、消化日数 で１レコードです。 下の記述で組んでおり、エラーも出ず、メッセージを確認する限りは、きちんと動いて、当該レコードの場合には”削除しました”のメッセージも出て、きれいに終わっているのですが、実際にはレコードが削除されていません。 チェックすべき点は、どこでしょうか？ ご教示おねがいいたします。 '********************** '*** 消化履歴クリア *** '********************** '実行の確認ポーズ yn = MsgBox("有休の履歴をクリアしますか？", vbYesNo, "確認！") If yn <> vbYes Then Exit Sub End If '消化履歴(有給休暇：テーブル） 当該社員の全レコードを削除しクリアする Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset Dim tbl As String Set cnn = CurrentProject.Connection Set rs = New ADODB.Recordset tbl = "有給休暇" Call rs.Open(tbl, cnn, adOpenForwardOnly, adLockBatchOptimistic) rs.MoveFirst Do While rs.EOF = False MsgBox "form社員コード= 【" & [Forms]![フォーム基本情報]![社員コード] & "】", , "確認" MsgBox "tbl社員コード= 【" & rs("社員コード").Value & "】", , "確認" If rs("社員コード").Value = [Forms]![フォーム基本情報]![社員コード] Then rs.Delete MsgBox "削除しました【" & rs("社員コード").Value & "】", , "確認" End If Call rs.MoveNext Loop Call rs.Close Set rs = Nothing Set cnn = Nothing
- ベストアンサー
- オフィス系ソフト
- VBAでの「メソッドまたはデータメンバが見つかりま
word2016で以下のプログラムを流したいのですが、「メソッドまたはデータメンバが見つかりません」のエラーが出ます。 Dim CB As Variant, i As Long CB = Application.ClipboardFormats If CB(1) = True Then MsgBox ”クリップボードになにも値がありません。”,48 Exit Sub End If どうすれば直るでしょうか？よろしくお願いします。
- 締切済み
- オフィス系ソフト
- Wi-Fiのランプが二つともチカチカして印刷ができない問題が発生しています。どんな作業をしているときにこの問題が起きるのでしょうか？
- ご利用の製品型番はEW-052Aで、PCのOSはWindows10です。Wi-Fiのランプが二つともチカチカして印刷ができない症状が発生しています。
- EPSON社製品のEW-052Aを使用していますが、Wi-Fiのランプが二つともチカチカして印刷ができません。どのような作業をしているときにこの症状が出るのでしょうか？
