Access ADO 更新

ADOによるレコードセットを使った更新方法を記載しておく。

Private Sub btn_更新_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String

On Error GoTo ErrRtn

SQL = “SELECT * FROM dbo_accounts WHERE MNO =” & Me!edit_MNO & “”

Set cn = CurrentProject.Connection
rs.Open SQL, cn, adOpenKeyset, adLockOptimistic

cn.BeginTrans

While Not rs.EOF

If rs!MNO = edit_MNO Then
rs!前月末残高 = edit_残高
Else
MsgBox (“一致するメーカーNOが存在しません。”)
End If

rs.Update
rs.MoveNext
Wend

cn.CommitTrans

rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

ExitErrRtn:
DoCmd.ShowAllRecords
Exit Sub

ErrRtn:
MsgBox “エラー: ” & Err.Description

cn.RollbackTrans
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

End Sub

Access レコードセットを2つ使いたい場合

本当は、1つのVBAの中で、2つのレコードセットを使う方法があるのかもしれないが、今回はこの方法で処理して解決しました。callで別のVBAにして処理をさせた。

Private Sub B在庫処理_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String

On Error GoTo ErrRtn

SQL = “SELECT * FROM dbo_stock_parts WHERE HNO =” & Me!call_HNO & “”
Set cn = CurrentProject.Connection
rs.Open SQL, cn, adOpenKeyset, adLockOptimistic

cn.BeginTrans

While Not rs.EOF
If IsNull(call_在庫確認) Then

If IsNull(rs!在庫数) Then
rs!在庫数 = call_数量
Else
rs!在庫数 = rs!在庫数 + call_数量
End If
Else
rs!在庫数 = rs!在庫数 – call_数量
End If
rs.Update
rs.MoveNext
Wend

cn.CommitTrans

rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

ExitErrRtn:

Call stock
Exit Sub

ErrRtn:
MsgBox “エラー: ” & Err.Description

cn.RollbackTrans
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
End Sub

※callで下記のVBAを呼ばせて処理をさせている。

Sub stock()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String

On Error GoTo ErrRtn

SQL = “SELECT * FROM dbo_receiving_materials WHERE JNO =” & Me!call_JNO & “”

Set cn = CurrentProject.Connection
rs.Open SQL, cn, adOpenKeyset, adLockOptimistic

cn.BeginTrans

While Not rs.EOF
If IsNull(call_在庫確認) Then
rs!在庫確認 = “在庫済”
MsgBox (“在庫更新しました。”)
Else
rs!在庫確認 = Null
MsgBox (“在庫取消しました。”)
End If
rs.Update
rs.MoveNext
Wend

cn.CommitTrans

rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

ExitErrRtn:

DoCmd.ShowAllRecords
Exit Sub

ErrRtn:
MsgBox “エラー: ” & Err.Description

cn.RollbackTrans
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

End Sub

Access ADO レコードセットデータをフォームに入力

dbo_mst_productテーブルから、フォームの製品コード検索内容から、製品名コードで一致したものをフォームのテキストボックスへ入力するためのVBA

Private Sub btn_完全一致_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim stCri As String

Set cn = CurrentProject.Connection
rs.Open “dbo_mst_product”, cn, adOpenKeyset, adLockOptimistic

stCri = “製品名コード='” & Me.製品コード検索 & “‘”
rs.Find stCri

If rs.EOF Then
MsgBox (“検索データがありません。”)
Else
Me!PNO = rs!PNO
Me!受注製品コード = rs!製品名コード
Me!受注製品名 = rs!製品名
Me!受注製品型式 = rs!製品型式
Me!価格 = rs!価格
End If

製品コード検索 = Null

rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
End Sub

Access PDFファイルを個別とグループ別に出力

なんとか、グループ毎には出力する方法を考えてできたが、個別も同時に出力したい場合の方法を記す。

すべてを、2種類用意すればいいってことです。レコードセットも2種類オープンする。

Private Sub web_output_Click()

Const TBL_NAME = “web_pdf_output”
Const RPT_NAME = “repo_web_pdf_output”
Const TBL_NAME0 = “web_pdf_output0”
Const RPT_NAME0 = “repo_web_pdf_output0”
Const PDF_PATH = “D:\NTT\”

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

Dim rs0 As ADODB.Recordset
Set rs0 = New ADODB.Recordset

Dim myStr As String

Do While True
myStr = InputBox(“yyyymmの形式を入力してください。”)

‘—(1)キャンセルしたとき
If StrPtr(myStr) = 0 Then
MsgBox “キャンセルします”
Exit Sub

‘—(2)空欄のまま[OK]したとき
ElseIf myStr = “” Then
MsgBox “未入力です”, vbExclamation

‘—(3)入力文字が6文字より長いとき
ElseIf Len(myStr) > 6 Then
MsgBox “文字が長すぎます”, vbExclamation

Else
‘—(4)入力文字が6文字以内のとき
MsgBox “入力された文字列は「” & myStr & “」です”
GoTo Nextjob
End If
Loop

Nextjob:

rs.Open “SELECT DISTINCT FID FROM web_pdf_output”, CurrentProject.Connection, adOpenStatic, adLockReadOnly

Do Until rs.EOF

DoCmd.OpenReport RPT_NAME, acViewPreview, , “FID=” & rs!FID, acWindowNormal
DoCmd.OutputTo acOutputReport, RPT_NAME, acFormatPDF, PDF_PATH & rs!FID & “0000” & myStr & “.PDF”
DoCmd.Close
rs.MoveNext
Loop

rs0.Open “SELECT DISTINCT ID FROM web_pdf_output0”, CurrentProject.Connection, adOpenStatic, adLockReadOnly

Do Until rs0.EOF

DoCmd.OpenReport RPT_NAME0, acViewPreview, , “ID=” & rs0!ID, acWindowNormal
DoCmd.OutputTo acOutputReport, RPT_NAME0, acFormatPDF, PDF_PATH & rs0!ID & myStr & “.PDF”
DoCmd.Close
rs0.MoveNext
Loop
rs0.Close

End Sub