accessからエクセルのデータ転送上書きVBA

質問

宜しくお願い致します
win10 access365

先日、ここでお尋ねした
アクセスファイルのVBAコードからエクセルファイルを作成するための
コードをお尋ねし、以下では

L.xlsxが作成されて、
アクセスのテーブル　KJKTから　データ転送が
行われるというコードを教示頂きました

しかしながら
同様の操作をするときに
L.xlsxのデータが
上書きされずに
以前に作ったデータのまま
残ってしまってました
そこで
以下のようなエクセルVBAを
R.xlsmに作りました
Ldataclear()
です

毎回
このマクロを実行して
いったんL.xlsxの
データを当該シートから削除して
まっさらにして
そのうえで
Exp123()を実行すれば
目的は叶うのですが
迂遠なような気もしました
もっと簡単に
上書き保存のできる
コードなど
あるのでありましたら
御教示くださいませ

宜しくお願い致します

Private Function Exp123()

'変数宣言
Dim srchXls As String

'Excelエクスポート先のファイルパス
srchXls = "C:\Users\USER\Desktop\ACCESS\L.xlsx"

'Excelファイルの出力
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "KJKT", srchXls, True, "output"
'Excelファイルをエクスポートした旨を通知する。
MsgBox "Excelをエクスポートしました。"

End Function

----------------------

Public Function ExcelRmacro()
Dim oApp As Object

Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'Only XL 97 supports UserControl Property
On Error Resume Next
oApp.UserControl = True

'ファイルを開く
oApp.Workbooks.Open FileName:="C:\Users\USER\Desktop\ACCESS\R.xlsm"

oApp.Application.Run ("'R.xlsm'!Ldataclear")

End Function

--------------------------------

Sub Ldataclear()
'
FilePath = "C:\Users\USER\Desktop\ACCESS\L.xlsx" 'ここにファイルの場所ファイル名を記載
Set Wb = GetObject(FilePath)
Set Ws = Wb.Worksheets("output") 'ここにシートを記載する

Ws.Cells.Delete

Wb.Save
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub

回答No.3

kkkkkm · ベストアンサー

余計なお世話ですが

データをoutputシートから削除するのに'R.xlsmのマクロを使わずにAccessのVBAだけで実行する方法です。
Exp123()を実行するだけでデータ削除からエクスポートまで処理します。全て同じモジュールに記載してください。

Private Function Exp123()

'変数宣言
Dim srchXls As String
Dim Ws_Name As String

'Excelエクスポート先のファイルパス
srchXls = "c:\ok\access\L.xlsx" '"C:\Users\USER\Desktop\ACCESS\L.xlsx"
Ws_Name = "output"

'Ldataclearを呼び出す　ファイルが開いているとエクスポートせずに終了
If Ldataclear(srchXls, Ws_Name) = False Then
MsgBox "処理を中止しました。", vbInformation
Exit Function
End If
'Excelファイルの出力
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "KJKT", srchXls, True, Ws_Name
''Excelファイルをエクスポートした旨を通知する。
MsgBox "Excelをエクスポートしました。", vbInformation

End Function

'エクセルシートのデータを削除する　Exp123から呼び出される
Private Function Ldataclear(ByVal srchXls As String, ByVal Ws_Name As String) As Boolean
Dim oApp As Object
Dim Wb As Object
Dim Ws As Object

'該当ファイルがあれば実行する
If Dir(srchXls) <> "" Then
Set oApp = CreateObject("Excel.Application")
Set Wb = oApp.Workbooks.Open(srchXls)
'既にファイルが開いているときの処理　開いていればデータを削除せずにFalseでExp123に戻る
If Wb.readonly Then
MsgBox Mid(srchXls, InStrRev(srchXls, "\") + 1) & "が開いています。" & vbCrLf & "必要に応じて保存して閉じるなどの処置をしてください。", vbInformation
Wb.Close
oApp.Quit
Set oApp = Nothing
Set Wb = Nothing
Ldataclear = False
Exit Function
End If

Set Ws = Wb.WorkSheets(Ws_Name)

Ws.Cells.ClearContents '.Delete
Wb.Save
Wb.Close
oApp.Quit

Set oApp = Nothing
Set Wb = Nothing
Set Ws = Nothing

Ldataclear = True
Else
MsgBox Mid(srchXls, InStrRev(srchXls, "\") + 1) & "ファイルがありません。", vbCritical
Ldataclear = False
End If

End Function

お礼

有り難うございました。読み込んでみます

Powered by GRATICA

回答No.2

luka3

・Ａｃｃｅｓｓ２０１０、TransferSpreadsheetは上書きできないのが仕様
https://excelshogikan.com/tips/tips220.html

「仕様」と書いてありますが、根拠は不明です。

・AccessVBAのExcelエクスポートについて
https://teratail.com/questions/44841

＞ObjExcel.Range("A2").CopyFromRecordset [テーブルの中身]
＞Set WB = ObjExcel.Workbooks.Open([Excelファイルパス])
＞WB.Close SaveChanges:=True

コードが若干不足していますが、CopyFromRecordset で上書きできたという報告です。

お礼

TransferSpreadsheetは上書きできないのが仕様　ここが知らないとどうにもならなかったところでした　有り難うございました。

Powered by GRATICA

回答No.1

kkkkkm

2013だと上書きしてくれるのですがバージョンによって違うのかもしれませんね。

エクセルファイルに他のデータが無いのでしたら
以下のサイトの方法でファイルそのものをKillするという方法もあります。

AccseeVBA Excelエクスポート　決まったファイル名で上書き保存する
https://sebastiansubway.hatenablog.com/entry/2017/09/11/173653

お礼

kill ステートメント　参照を巡回しまして　出来ました 有り難うございました。

Powered by GRATICA

補足

Private Function killLxlsx()

'変数宣言
Dim srchXls As String

'前回のExcelエクスポート先のファイルパス

srchXls = "C:\Users\USER\Desktop\ACCESS\L.xlsx"

If Dir(srchXls) <> "" Then
Kill srchXls
End If

End Function
以上で　出来ました
有り難うございました。