アクセスVBA CSVへ出力後、最終レコードの次の行に任意の文字を入れたい

質問

VBA超初心者です。宜しくお願いします。

今回は、テーブルからエクセルへ出力後、最終レコードの次の行に任意の文字を入れたいというのがわからず質問です。

全体の流れとしては、エクセル起動→テーブル名1を出力→テーブル名2を出力→CSV形式で保存となります。

このテーブル名2を出力した際の処理についてです。以下の記述の中で、”★★テーブル名2を貼り付け”の処理を追加、変更などする形で考えたいのですが、よい方法はございませんでしょうか？

具体的には【テーブル名2をエクセルの任意の範囲に出力】→最終レコードの次行の特定の列を複数指定して任意の文字”END”を入れる。
（例：貼り付け開始がB25、データが3レコードであれば、28行目の任意の列（CとE）を指定して”END"といれる）
なお、テーブル名2のレコード数は毎回ことなります。

説明不足の場合はご指摘ください。
御知恵を拝借したく宜しくお願いします。
---------------------------
Sub opnXLtmp3()
On Error GoTo Err_opnXLtmp3

Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim cnn2 As ADODB.Connection
Dim rst2 As ADODB.Recordset
Dim stBasis As String
Dim stDetail As String
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim fName As Variant
Dim stPath As String 'mdb & Excel Book Path
Dim stXLName As String 'Book Name
Dim stSheet As String 'Sheet Name
Dim stRng As String 'Range Address

stPath = CurrentProject.Path '自mdb & Excel Book のパス
stXLName = "ファイル名.csv" 'テンプレート用の Book
stBasis = "テーブル名1" 'テーブル名1
stDetail = "テーブル名2" 'テーブル名2
stSheet = "シート名" '出力するシート名
stRng = "B25" '出力開始セル番地

Set cnn = CurrentProject.Connection
Set cnn2 = CurrentProject.Connection
Set rst2 = cnn2.Execute(stBasis)
Set rst = cnn.Execute(stDetail)

'テンプレート としてオープン
Set xls = CreateObject("Excel.Application")
xls.Workbooks.Add template:=stPath & stXLName
Set wkb = xls.Workbooks(1)

　　'テーブル名1を貼り付け
With wkb.Worksheets(stSheet)
.Cells(3, 10) = rst2("番号")
End With

'★★テーブル名2を貼り付け
With wkb.Worksheets(stSheet)
.Range(stRng).CopyFromRecordset Data:=rst

　　　'ここに .Cells(X, 3) = "END" じゃだめでした。
　　　'ここに .Cells(X, 5) = "END" じゃだめでした。

End With

'Excel画面を表示して終了(保存しない)
xls.Visible = True

fName = xls.Application.GetSaveAsFilename("ファイル名3" & rst2("番号"), _
"CSVファイル(*.csv),*.csv", 1)

If fName <> False Then
wkb.SaveAs FileName:=fName
MsgBox "新規ブックは、「" & fName & "」の名前で保存しました！", vbOKOnly
Else
MsgBox "新規ブックは保存できませんでした。", vbOKOnly
End If
End Sub

回答No.2

kuroooooo · ベストアンサー

カーソルをクライアントカーソルに変更してみてください。
Set cnn = CurrentProject.Connection
cnn.CursorLocation = adUseClient　　　 <=追加
Set cnn2 = CurrentProject.Connection
Set rst2 = cnn2.Execute(stBasis)
Set rst = cnn.Execute(stDetail)
その上で最初に回答したコードでやってみてください。

お礼

うまくいきました！大変助かりました！
また宜しくお願い致します！

回答No.1

kuroooooo

'★★テーブル名2を貼り付け
With wkb.Worksheets(stSheet)
.Range(stRng).CopyFromRecordset Data:=rst
　　.Cells(rst.RecordCount + 25, 3) = "END"
.Cells(rst.RecordCount + 25, 5) = "END"
End With
かな。
レコードセットのRecoudCountプロパティでレコード数を取得して、
行の初期位置に加算してやるという考え方です。

お礼

早速のご回答ありがとうございます。
ご教授いただいた方法で試してみましたが当方の力量不足により
うまくいかないようです。すいません。

実行したのは以下となります。

　　'★★テーブル名2を貼り付け
With wkb.Worksheets(stSheet)
.Range(stRng).CopyFromRecordset Data:=rst
.Cells(rst.RecordCount + 25, 3) = "END"
.Cells(rst.RecordCount + 25, 5) = "END"
End With

実行結果は、24行目のC列とE列に”END”と入ります。
試しに以下のように、レコード数3+1＝4を追加して+29で実行すると
入れたい列（28列目）にちゃんと入りました。

With wkb.Worksheets(stSheet)
.Range(stRng).CopyFromRecordset Data:=rst
.Cells(rst.RecordCount + 29, 3) = "END"
.Cells(rst.RecordCount + 29, 5) = "END"
End With

ということは"rst.RecordCount"が数値として認識されてない？のかなぁ？と勝手に想像し、以下もやってみましたがやっぱりダメでした。
浅はかですいません。。実行結果は24行目のC列とE列に”END”と入ります。

Dim figA As Integer
figA = rst.RecordCount
figA = (figA + 25)

With wkb.Worksheets(stSheet)
.Range(stRng).CopyFromRecordset Data:=rst
.Cells(figA, 1) = "EOL"
.Cells(figA, 4) = "EOL"
End With

すいませんがもう少し教えていただけますでしょうか？

補足

すいません、訂正です。最後に試したのは以下となります。

Dim figA As Integer
figA = rst.RecordCount
figA = (figA + 25)

With wkb.Worksheets(stSheet)
.Range(stRng).CopyFromRecordset Data:=rst
.Cells(figA, 3) = "END"
.Cells(figA, 5) = "END"
End With