AccessVBA クラスオブジェクト①商品検索

Option Compare Database
‘3つの条件の項目を代入する変数を定義
Dim F1 As String, F2 As String, F3 As String
‘取得した値を代入する変数を定義
Dim J1 As String, J2 As String, J3 As String, J4 As String
‘並べ替え条件の変数を定義
Dim MySort As String
‘テーブル名とフィールド名の変数を定義
Dim TableName As String, FieldName1 As String, FieldName2 As String, FieldName3 As String
Private Sub Excelへエクスポートボタン_Click()
On Error GoTo err_Shori

‘今日の日付でファイル名作成
Dim FileName As String
FileName = Format(Now, “yyyymmdd_hhnn”) & “_商品抽出一覧.xlsx”
‘出力先のパス(ファイル名まで含む)
Dim Path As String
Path = Me.txtPath.Value
‘テーブルをエクセルでエクスポート
Call ExcelExport(Path, FileName, “仮_tb商品検索一覧表用2”)

‘終了処理
err_Exit:
Exit Sub

‘エラー処理
err_Shori:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Private Sub Form_Load()

F1 = “”: F2 = “”: F3 = “”

‘テキスト等を空にする
With Me
.txt商品コード.Value = “”
.txt仕入開始日.Value = “”
.txt仕入終了日.Value = “”
.txt売上開始日.Value = “”
.txt売上終了日.Value = “”
.txt仕入先コード.Value = “”
.txt売上先コード.Value = “”
.txtPath.Value = “C:\Users\golive\Desktop\Access_BackUp”
.cmbブランド.Value = “”
.cmb商品ステータス.Value = “”
.cmb商品分類.Value = “”
.list取引先.RowSource = “”
.txtコメント.Value = “”
.frame1.Value = “”
.frame2.Value = “”
.frame3.Value = “”
.frame取引先選択.Value = “”
End With

End Sub

Private Sub Form_Open(Cancel As Integer)
FormSizeSquare2
Me.PictureType = 0
Me.Picture = BgImageDataPath
End Sub

Private Sub frame1_AfterUpdate()
On Error GoTo err_Shori

Select Case Me.frame1.Value
Case Me.opt1.OptionValue
‘条件の取得
F1 = “商品コード”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = False: Me.optb1.Enabled = False: Me.optc1.Enabled = False: Me.optd1.Enabled = False: Me.opte1.Enabled = False
Me.opta2.Enabled = False: Me.optb2.Enabled = False: Me.optc2.Enabled = False: Me.optd2.Enabled = False: Me.opte2.Enabled = False

Case Me.opt2.OptionValue
‘条件の取得
F1 = “商品分類”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = False: Me.optd1.Enabled = True: Me.opte1.Enabled = True
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = False: Me.optd2.Enabled = True: Me.opte2.Enabled = True

Case Me.opt3.OptionValue
‘条件の取得
F1 = “ブランド”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = True: Me.optd1.Enabled = False: Me.opte1.Enabled = True
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = True: Me.optd2.Enabled = False: Me.opte2.Enabled = True

Case Me.opt4.OptionValue
‘条件の取得
F1 = “ステータス”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = True: Me.optd1.Enabled = True: Me.opte1.Enabled = False
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = True: Me.optd2.Enabled = True: Me.opte2.Enabled = False

Case Me.opt5.OptionValue
‘条件の取得
F1 = “仕入日”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = True: Me.optd1.Enabled = True: Me.opte1.Enabled = True
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = True: Me.optd2.Enabled = True: Me.opte2.Enabled = True
Case Me.opt6.OptionValue
‘条件の取得
F1 = “売却日”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = True: Me.optd1.Enabled = True: Me.opte1.Enabled = True
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = True: Me.optd2.Enabled = True: Me.opte2.Enabled = True
Case Else

End Select
‘終了処理
err_Exit:
Exit Sub

‘エラー処理
err_Shori:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Private Sub frame2_AfterUpdate()

On Error GoTo err_Shori

Select Case Me.frame2.Value
Case Me.opta1.OptionValue
‘条件の取得
F2 = “取引先名”
F3 = “”
TableName = “tb取引先マスタ”
FieldName1 = “取引先コード”
FieldName2 = “取引先名”
FieldName3 = “カナ”
MsgBox “右側のリストより、仕入先名を選択し、ダブルクリックしてください。”
‘条件選択内容により、一部を選択不可とする
Me.opta2.Enabled = False
Me.txt仕入先コード.Enabled = True
Me.txtコメント.Value = “仕入先”

Case Me.optb1.OptionValue
‘条件の取得
F2 = “売却先名”
F3 = “”
MsgBox “右側のリストより、売上先名を選択し、ダブルクリックしてください。”
TableName = “tb売上先マスタ”
FieldName1 = “売却先コード”
FieldName2 = “売却先名”
FieldName3 = “カナ”
‘条件選択内容により、一部を選択不可とする
Me.opta2.Enabled = True: Me.optb2.Enabled = False
Me.txt売上先コード.Enabled = True
Me.txtコメント.Value = “売上先”

Case Me.optc1.OptionValue
‘条件の取得
F2 = “商品分類”
F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.optc2.Enabled = False
Me.cmb商品分類.Enabled = True

Case Me.optd1.OptionValue
‘条件の取得
F2 = “ブランド”
F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.optd2.Enabled = False
Me.cmbブランド.Enabled = True

Case Me.opte1.OptionValue
‘条件の取得
F2 = “ステータス”
F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opte2.Enabled = False
Me.cmb商品ステータス.Enabled = True
Case Else

End Select

‘終了処理
err_Exit:
Exit Sub

‘エラー処理
err_Shori:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Private Sub frame3_AfterUpdate()

On Error GoTo err_Shori

Select Case Me.frame3.Value
Case Me.opta2.OptionValue
‘条件の取得
F3 = “取引先名”
MsgBox “右側のリストより、仕入先名を選択し、ダブルクリックしてください。”
TableName = “tb取引先マスタ”
FieldName1 = “取引先コード”
FieldName2 = “取引先名”
FieldName3 = “カナ”
‘条件選択内容により、一部を選択不可とする
Me.txt仕入先コード.Enabled = True
Me.txtコメント.Value = “仕入先”

Case Me.optb2.OptionValue
‘条件の取得
F3 = “売却先名”
MsgBox “右側のリストより、売上先名を選択し、ダブルクリックしてください。”
TableName = “tb売上先マスタ”
FieldName1 = “売却先コード”
FieldName2 = “売却先名”
FieldName3 = “カナ”
‘条件選択内容により、一部を選択不可とする
Me.txt売上先コード.Enabled = True
Me.txtコメント.Value = “売上先”

Case Me.optc2.OptionValue
‘条件の取得
F3 = “商品分類”

‘条件選択内容により、一部を選択不可とする
Me.cmb商品分類.Enabled = True

Case Me.optd2.OptionValue
‘条件の取得
F3 = “ブランド”

‘条件選択内容により、一部を選択不可とする
Me.cmbブランド.Enabled = True

Case Me.opte2.OptionValue
‘条件の取得
F3 = “ステータス”

‘条件選択内容により、一部を選択不可とする
Me.cmb商品ステータス.Enabled = True

Case Else

End Select

‘終了処理
err_Exit:
Exit Sub

‘エラー処理
err_Shori:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Private Sub frame4_AfterUpdate()

On Error GoTo err_Shori

Select Case Me.frame4.Value
Case Me.chk1.OptionValue
MySort = “仕入日”
Case Me.chk2.OptionValue
MySort = “売却日”
Case Me.chk3.OptionValue
MySort = “商品分類”
Case Me.chk4.OptionValue
MySort = “ブランド”
Case Me.chk5.OptionValue
MySort = “取引先名”
Case Me.chk6.OptionValue
MySort = “売却先名”
Case Me.chk7.OptionValue
MySort = “買番号”
Case Else
MySort = “商品コード”
End Select

‘終了処理
err_Exit:
Exit Sub

‘エラー処理
err_Shori:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Private Sub frame取引先選択_AfterUpdate()
‘***************************************************************************
‘*
‘* カナ選択で、候補のリストを表示、選択できるようにする
‘*
‘***************************************************************************

On Error GoTo err_Shori

‘***************************************************************************
‘*
‘* カナ選択で、候補のリストを表示、選択できるようにする
‘*
‘***************************************************************************
Dim strSql As String, MySQL As String
Dim KanaList As Variant
Dim I As Long

Select Case Me.frame取引先選択.Value
Case Me.op1.OptionValue
KanaList = Array(“ア”, “イ”, “ウ”, “エ”, “オ”)
Case Me.op2.OptionValue
KanaList = Array(“カ”, “キ”, “ク”, “ケ”, “コ”, “ガ”, “ギ”, “グ”, “ゲ”, “ゴ”)
Case Me.op3.OptionValue
KanaList = Array(“サ”, “シ”, “ス”, “セ”, “ソ”, “ザ”, “ジ”, “ズ”, “ゼ”, “ゾ”)
Case Me.op4.OptionValue
KanaList = Array(“タ”, “チ”, “ツ”, “テ”, “ト”, “ダ”, “ヂ”, “ヅ”, “デ”, “ド”)
Case Me.op5.OptionValue
KanaList = Array(“ナ”, “ニ”, “ヌ”, “ネ”, “ノ”)
Case Me.op6.OptionValue
KanaList = Array(“ハ”, “ヒ”, “フ”, “ヘ”, “ホ”, “バ”, “ビ”, “ブ”, “ベ”, “ボ”, “パ”, “ピ”, “プ”, “ペ”, “ポ”)
Case Me.op7.OptionValue
KanaList = Array(“マ”, “ミ”, “ム”, “メ”, “モ”)
Case Me.op8.OptionValue
KanaList = Array(“ヤ”, “ユ”, “ヨ”)
Case Me.op9.OptionValue
KanaList = Array(“ラ”, “リ”, “ル”, “レ”, “ロ”)
Case Me.op10.OptionValue
KanaList = Array(“ワ”, “ヲ”, “ン”)
Case Me.op11.OptionValue
GoTo Filter_End
Case Else
MsgBox “取引先名の先頭の文字が選択されていません”
End Select

MySQL = “(カナ LIKE ‘” & KanaList(0) & “*’) ”
Select Case Me.frame取引先選択.Value
Case 1, 5, 7, 9
For I = 1 To 4
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case 2, 3, 4
For I = 1 To 9
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case 6
For I = 1 To 14
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case 8, 10
For I = 1 To 2
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case Else
End Select

strSql = “SELECT ” & FieldName1 & “,” & FieldName2 & “,” & FieldName3 & ” FROM ” & TableName & ” WHERE ” & MySQL & ” ORDER BY ” & FieldName3 & “;”

‘カナ昇順で並べ替え付与し、リストのソース指定
Me.list取引先.RowSource = strSql
Me.list取引先.Requery
Exit Sub

Filter_End:
Me.list取引先.ColumnCount = 3
Me.list取引先.RowSourceType = “Table/Query”
Me.list取引先.RowSource = “SELECT ” & FieldName1 & “,” & FieldName2 & “,” & FieldName3 & ” FROM ” & TableName & ” ORDER BY ” & FieldName2 & “;”

‘終了処理
err_Exit:
Exit Sub

‘エラー処理
err_Shori:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Private Sub list取引先_DblClick(Cancel As Integer)
‘ダブルクリックで、仕入先名、売却先名を取得
If TableName = “tb売上先マスタ” Then
Me.txt売上先コード.Value = Me.list取引先.Column(1)

ElseIf TableName = “tb取引先マスタ” Then
Me.txt仕入先コード.Value = Me.list取引先.Column(1)

End If
End Sub

Private Sub TOPへ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenMain
CloseForm (“fm商品検索2”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub リセットボタン_Click()
F1 = “”: F2 = “”: F3 = “”
J1 = “”: J2 = “”: J3 = “”: J4 = “”
MySort = “”

‘テキスト等を空にする
With Me
.txt商品コード.Value = “”
.txt仕入開始日.Value = “”
.txt仕入終了日.Value = “”
.txt売上開始日.Value = “”
.txt売上終了日.Value = “”
.txt仕入先コード.Value = “”
.txt売上先コード.Value = “”
.cmbブランド.Value = “”
.cmb商品ステータス.Value = “”
.cmb商品分類.Value = “”
.list取引先.RowSource = “”
.txtコメント.Value = “”
.frame1.Value = “”
.frame2.Value = “”
.frame3.Value = “”
.frame取引先選択.Value = “”
End With
End Sub

Private Sub 一覧表示ボタン_Click()

On Error GoTo err_Shori

‘[仮_tb商品検索一覧表用2]テーブルのデータを全件削除する
TableClear (“仮_tb商品検索一覧表用2”)

Dim MySQL1 As String, MySQL2 As String
If Me.frame4.Value = 7 Then
‘<並べ替え条件が「買番号」の場合>ソートしたレコードセットを、[仮_tb商品検索一覧表用2]テーブルに再セットする

‘買番号で「-」の左側の桁数が1桁をセレクトし、テーブルに追加。
MySQL1 = “INSERT INTO 仮_tb商品検索一覧表用2 SELECT * FROM 仮_tb商品検索一覧表用 WHERE Len(仮_tb商品検索一覧表用.買番号) = 1 ORDER BY 買番号;”
DoCmd.RunSQL MySQL1

‘買番号で「-」の左側の桁数が1桁以外をセレクトし、テーブルに追加。
MySQL2 = “INSERT INTO 仮_tb商品検索一覧表用2 SELECT * FROM 仮_tb商品検索一覧表用 WHERE Len(仮_tb商品検索一覧表用.買番号) <> 1 ORDER BY 買番号;”
‘ MySQL2 = “INSERT INTO 仮_tb商品検索一覧表用2 SELECT * FROM 仮_tb商品検索一覧表用 WHERE Abs(InStr(仮_tb商品検索一覧表用.買番号,” – “)-1) <> 1 ORDER BY 買番号;”
DoCmd.RunSQL MySQL2

Else
‘<並べ替え条件が「買番号」以外の場合>ソートしたレコードセットを、[仮_tb商品検索一覧表用2]テーブルに再セットする
‘レコードセットを作成
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rrs As ADODB.Recordset

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rrs = New ADODB.Recordset

‘カーソルロケーションのプロパティ変更
rs.CursorLocation = adUseClient
‘ソート
rs.Open “仮_tb商品検索一覧表用”, cn
rs.Sort = MySort

rrs.Open “仮_tb商品検索一覧表用2”, cn, adOpenKeyset, adLockOptimistic

Do Until rs.EOF

With rrs
.AddNew
.Fields(0).Value = rs!商品コード
.Fields(1).Value = rs!ステータス
.Fields(2).Value = rs!仕入日
.Fields(3).Value = rs!取引先名
.Fields(4).Value = rs!買番号
.Fields(5).Value = rs!商品分類
.Fields(6).Value = rs!ブランド
.Fields(7).Value = rs!品番
.Fields(8).Value = rs!ライン
.Fields(9).Value = rs!商品名
.Fields(10).Value = rs!素材
.Fields(11).Value = rs!色
.Fields(12).Value = rs!付属品
.Fields(13).Value = rs!シリアルNo
.Fields(14).Value = rs!ランク
.Fields(15).Value = rs!予定_税抜売価
.Fields(16).Value = rs!税抜定価
.Fields(17).Value = rs!備考
.Fields(18).Value = rs!税抜原価
.Fields(19).Value = rs!税込原価
.Fields(20).Value = rs!売却日
.Fields(21).Value = rs!税抜売価
.Fields(22).Value = rs!税込売価
.Fields(23).Value = rs!売却先名
.Update
.MoveNext
End With

rs.MoveNext
I = I + 1
Loop

rs.Close: rrs.Close: cn.Close
Set rs = Nothing: Set rrs = Nothing: Set cn = Nothing
End If

DoCmd.OpenReport “r仮_tb商品検索一覧表用2”, acViewReport, , , acDialog

‘終了処理
err_Exit:
Exit Sub

‘エラー処理
err_Shori:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Private Sub 参照ボタン_Click()
Me.txtPath.Value = FDFolderPicker
End Sub

Private Sub 商品管理画面へ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenForm (“fm商品管理”)
CloseForm (“fm商品検索2”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub 全件表示ボタン_Click()

On Error GoTo err_Shori

‘ DoCmd.OpenReport “r商品一覧”, acViewReport, , , acDialog
‘[仮_tb商品検索一覧表用]テーブルのデータを全件削除する
TableClear (“仮_tb商品検索一覧表用2”)
‘レコードセットを作成
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rrs As ADODB.Recordset

Dim ID As Variant, Baika As Variant, I As Long

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rrs = New ADODB.Recordset

‘カーソルロケーションのプロパティ変更
rs.CursorLocation = adUseClient
‘開いてソートする
rs.Open “q商品一覧”, cn, adOpenKeyset, adLockOptimistic
rs.Sort = “商品コード”

‘[仮_tb商品検索一覧表用2]フィールドに値を追加します。
rrs.Open “仮_tb商品検索一覧表用2”, cn, adOpenKeyset, adLockOptimistic

MsgBox rs.RecordCount & “件のデータを表示します。”

Do Until rs.EOF

With rrs
.AddNew
.Fields(0).Value = rs!商品コード
.Fields(1).Value = rs!ステータス
.Fields(2).Value = rs!仕入日
.Fields(3).Value = rs!取引先名
.Fields(4).Value = rs!買番号
.Fields(5).Value = rs!商品分類
.Fields(6).Value = rs!ブランド
.Fields(7).Value = rs!品番
.Fields(8).Value = rs!ライン
.Fields(9).Value = rs!商品名
.Fields(10).Value = rs!素材
.Fields(11).Value = rs!色
.Fields(12).Value = rs!付属品
.Fields(13).Value = rs!シリアルNo
.Fields(14).Value = rs!ランク
.Fields(15).Value = rs!予定_税抜売価
.Fields(16).Value = rs!税抜定価
.Fields(17).Value = rs!備考
.Fields(18).Value = rs!税抜原価
.Fields(19).Value = rs!税込原価
.Fields(20).Value = rs!売却日
.Fields(21).Value = rs!税抜売価
.Fields(22).Value = rs!税込売価
.Fields(23).Value = rs!売却先名
.Update
.MoveNext
End With

rs.MoveNext
I = I + 1
Loop

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

DoCmd.OpenReport “r仮_tb商品検索一覧表用2”, acViewReport, , , acDialog

‘終了処理
err_Exit:
Exit Sub

‘エラー処理
err_Shori:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Private Sub 抽出ボタン_Click()

‘On Error GoTo err_Shori

‘3つの条件と、値を取得する
If F1 = “商品コード” Then
J1 = Me.txt商品コード.Value
ElseIf F1 = “商品分類” Then
J1 = Me.cmb商品分類.Column(1)
ElseIf F1 = “ブランド” Then
J1 = Me.cmbブランド.Column(1)
ElseIf F1 = “ステータス” Then
J1 = Me.cmb商品ステータス.Column(0)
ElseIf F1 = “仕入日” Then
J1 = Me.txt仕入開始日.Value
J2 = Me.txt仕入終了日.Value
ElseIf F1 = “売却日” Then
J1 = Me.txt売上開始日.Value
J2 = Me.txt売上終了日.Value
Else
MsgBox “第一条件が選択されていません。選択してください。”
End If

If F2 = “取引先名” Then
J3 = Me.txt仕入先コード.Value
ElseIf F2 = “売却先名” Then
J3 = Me.txt売上先コード.Value
ElseIf F2 = “商品分類” Then
J3 = Me.cmb商品分類.Column(1)
ElseIf F2 = “ブランド” Then
J3 = Me.cmbブランド.Column(1)
ElseIf F2 = “ステータス” Then
J3 = Me.cmb商品ステータス.Column(0)
End If

If F3 = “取引先名” Then
J4 = Me.txt仕入先コード.Value
ElseIf F3 = “売却先名” Then
J4 = Me.txt売上先コード.Value
ElseIf F3 = “商品分類” Then
J4 = Me.cmb商品分類.Column(1)
ElseIf F3 = “ブランド” Then
J4 = Me.cmbブランド.Column(1)
ElseIf F3 = “ステータス” Then
J4 = Me.cmb商品ステータス.Column(0)
End If

‘仮のテーブルを作成し、テーブルをダイアログで表示する

‘[仮_tb商品検索一覧表用]テーブルのデータを全件削除する
TableClear (“仮_tb商品検索一覧表用”)

‘レコードセットを作成
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rrs As ADODB.Recordset

Dim ID As Variant, Baika As Variant, I As Long
Dim sqlName As String, SQL As String

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rrs = New ADODB.Recordset

‘条件1について
SQL = “SELECT * FROM q商品一覧 WHERE ”
If F1 = “仕入日” Or F1 = “売却日” Then
J1 = Format(J1, “yyyy/mm/dd”)
J2 = Format(J2, “yyyy/mm/dd”)
sqlName = F1 & ” >= #” & J1 & “# AND ” & F1 & ” <= #" & J2 & "#" Else sqlName = F1 & " = '" & J1 & "'" End If '条件2,3について If F2 = "" Then GoTo RSyutoku Else sqlName = sqlName & " AND " & F2 & " = '" & J3 & "'" If F3 = "" Then GoTo RSyutoku Else sqlName = sqlName & " AND " & F3 & " = '" & J4 & "'" End If End If RSyutoku: SQL = SQL & sqlName & ";" rs.Open SQL, cn, adOpenKeyset, adLockOptimistic '[仮_tb商品検索一覧表用]フィールドに値を追加します。 rrs.Open "仮_tb商品検索一覧表用", cn, adOpenKeyset, adLockOptimistic MsgBox rs.RecordCount & "件のデータを抽出します。" Do Until rs.EOF With rrs .AddNew .Fields(0).Value = rs!商品コード .Fields(1).Value = rs!ステータス .Fields(2).Value = rs!仕入日 .Fields(3).Value = rs!取引先名 .Fields(4).Value = rs!買番号 .Fields(5).Value = rs!商品分類 .Fields(6).Value = rs!ブランド .Fields(7).Value = rs!品番 .Fields(8).Value = rs!ライン .Fields(9).Value = rs!商品名 .Fields(10).Value = rs!素材 .Fields(11).Value = rs!色 .Fields(12).Value = rs!付属品 .Fields(13).Value = rs!シリアルNo .Fields(14).Value = rs!ランク .Fields(15).Value = rs!予定_税抜売価 .Fields(16).Value = rs!税抜定価 .Fields(17).Value = rs!備考 .Fields(18).Value = rs!税抜原価 .Fields(19).Value = rs!税込原価 .Fields(20).Value = rs!売却日 .Fields(21).Value = rs!税抜売価 .Fields(22).Value = rs!税込売価 .Fields(23).Value = rs!売却先名 .Update .MoveNext End With rs.MoveNext I = I + 1 Loop rs.Close: rrs.Close: cn.Close Set rs = Nothing: Set rrs = Nothing: Set cn = Nothing MsgBox "抽出が完了しました。" '終了処理 err_Exit: Exit Sub 'エラー処理 err_Shori: MsgBox Err.Description Err.Clear Resume err_Exit: End Sub

About

You may also like...

Your email will not be published. Name and Email fields are required