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

Question

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

kuroooooo · Accepted Answer

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

kuroooooo · Answer

'★★テーブル名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プロパティでレコード数を取得して、
行の初期位置に加算してやるという考え方です。

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

カーソルをクライアントカーソルに変更してみてください。

'★★テーブル名2を貼り付け

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング