Access2010エクスポートしたい

質問

Microsoft Access2010 選択クエリデータをEXCEL2010にエクスポートしたいMicrosoft Access2010は高齢者で初心者なので分かりやすい表現で教えて下さい、フォーム上にコマンドボタンを設置しています、コマンドボタンクリック時、EXCEL2010　sheet1 A4を起点にエクスポートしたい

宜しくお願い致します。

回答No.4

nicotinism · ベストアンサー

>sFileName = oWH.specialfolders("DeskTop") '此処でデスクトップのPathを得ています。
>sFileName = sFileName & "\" & "1234.xlsx"
ここでファイル名を、★ → 1234 に↑代えてますから
★は見つからない・・・ということでは？

ついでに

～前略～
Set oSH = Nothing
Set oBK = Nothing
Set oXL = Nothing

createObject("Shell.Application").shellExecute sFileName
End Sub

と一行加えてください。
保存されたエクセルファイルが開かれます。

お礼

大変お手数お掛けし申し訳ありませんでした、別のＰＣで行った所、全く問題なくエクスポートが出来ました有り難うございました。

補足

おはようございます。おかしいですね、ご呈示のコード一行追加とファイル名を、★に変更し実行しましたがEXCEL自体起動しようとしません、申し訳ありません
Private Sub コマンド40_Click()

'Microsoft Office 14.0 Access Database Engine Object Library
' または Microsoft DAO 3.6 Object Library どちらか。
'と Microsoft Excel 14.0 Object Library
'VBEの画面で ツール(T) → 参照設定 から選んでチェックが入ってなかったら入れる
Dim rsFrom As DAO.Recordset
Dim oXL As Excel.Application
Dim oBK As Excel.Workbook
Dim oSH As Excel.Worksheet
Dim oWH As Object
Dim sFileName As String

Set rsFrom = CurrentDb.OpenRecordset("集金明細", dbOpenSnapshot) 'クエリ名は出力したいのに適宜変更
Set oXL = New Excel.Application
Set oBK = oXL.Workbooks.Add
Set oSH = oBK.Worksheets(1)
Set oWH = CreateObject("Wscript.Shell")

sFileName = oWH.specialfolders("DeskTop") '此処でデスクトップのPathを得ています。
sFileName = sFileName & "\" & "★.xlsx"

oSH.Range("A4").CopyFromRecordset rsFrom

oBK.SaveAs FileName:=sFileName
oBK.Close SaveChanges:=False
oXL.Quit

Set oWH = Nothing
rsFrom.Close: Set rsFrom = Nothing
Set oSH = Nothing
Set oBK = Nothing
Set oXL = Nothing
createObject("Shell.Application").shellExecute sFileName
End Sub

回答No.5

nicotinism

ん～～～～～
Windows を再起動する。
件のアクセスファイルを開く。（他のアプリケーションは開かない）
Alt + F11 を押してVBEの画面にし、コンパイルを行う。
（VBEのメニューから、デバッグ→○△のコンパイル）
VBEは閉じて、念のためにリボンのデータベースツール→最適化 を行う。
フォームのコマンドボタンを押してみる。

これでもExcelが立ち上がらない・エラーも出ないのなら
Set rsFrom = CurrentDb.OpenRecordset("集金明細", dbOpenSnapshot) 'クエリ名は出力したいのに適宜変更
クエリ名（"集金明細"）を指定していますが、
ここを適当なテーブル名にする。集金明細 → 適当なテーブル名
また、
上の行の前に
msgbox "ここは" & screen.activecontrol.name
と１行追加。
コマンドボタンを押してみる。

「ここは・・・」が出るか。
（・・・の部分がコマンドボタン名（コマンド40 になっているか確認）
エクセルが立ち上がるか。
（下？のタスクバーも見てください）
でどうでしょ？

上記の変更二か所（テーブル名・１行追加）を行って
コマンドボタンを押して、「ここは・・・」が出る。
・・・はコマンド40 になっている。
にも関わらず
エクセルが立ち上がらない、タスクバーにも現れないのなら
私は降参です。

回答No.3

nicotinism

不思議ですね。
それでは、あなたのコマンドボタンクリック時イベントの
コードを載せてみてください。

Private Sub コマンドなんとか名_Click()
から
End Sub
まで全部です。

補足

お手数おかけします。

Private Sub コマンド40_Click()

'Microsoft Office 14.0 Access Database Engine Object Library
' または Microsoft DAO 3.6 Object Library どちらか。
'と Microsoft Excel 14.0 Object Library
'VBEの画面で ツール(T) → 参照設定 から選んでチェックが入ってなかったら入れる
Dim rsFrom As DAO.Recordset
Dim oXL As Excel.Application
Dim oBK As Excel.Workbook
Dim oSH As Excel.Worksheet
Dim oWH As Object
Dim sFileName As String

Set rsFrom = CurrentDb.OpenRecordset("集金明細", dbOpenSnapshot) 'クエリ名は出力したいのに適宜変更
Set oXL = New Excel.Application
Set oBK = oXL.Workbooks.Add
Set oSH = oBK.Worksheets(1)
Set oWH = CreateObject("Wscript.Shell")

sFileName = oWH.specialfolders("DeskTop") '此処でデスクトップのPathを得ています。
sFileName = sFileName & "\" & "1234.xlsx"

oSH.Range("A4").CopyFromRecordset rsFrom

oBK.SaveAs FileName:=sFileName
oBK.Close SaveChanges:=False
oXL.Quit

Set oWH = Nothing
rsFrom.Close: Set rsFrom = Nothing
Set oSH = Nothing
Set oBK = Nothing
Set oXL = Nothing

End Sub

回答No.2

nicotinism

>うまく動作しないようです
何を
どうして
どのような結果
になったのかの説明が無いと
当方では対処のしようもありません。

回答者の目に浮かぶように詳しく行った事と状況を説明してください。
こちらでは投稿する前にも検証済みです。

補足

大変お手数お掛けします、フォームデザインビューにて作成したコマンドボタンを右クリックしイベントビルドからコードビルダーを選択し教えて頂いたコードを貼り付けました、エラーメッセージは何も出ませんが、エクセルファイルが出来ません。
当初ご指摘のMicrosoft DAO 3.6 Object Library どちらか。
'と Microsoft Excel 14.0 Object Library
にもチェックを入れましたがDISK TOP上に"★.xlsx"
ファイルが出来ません、当方不手際がありましたらお許し下さい。

回答No.1

nicotinism

コマンドボタンクリック時のコードに下記内容を入れてください。
デスクトップに、★.xlsx が出来ます。
分かりやすくするためにくどい書き方かも。中のコメントにも注目。
余計に分かりにくかったらご容赦。
※メモ型のフィールドが含まれている場合は255文字以内で切り捨てられます。

'要 参照設定
'Microsoft Office 14.0 Access Database Engine Object Library
' または Microsoft DAO 3.6 Object Library どちらか。
'と Microsoft Excel 14.0 Object Library
'VBEの画面で ツール(T) → 参照設定 から選んでチェックが入ってなかったら入れる
Dim rsFrom As DAO.Recordset
Dim oXL As Excel.Application
Dim oBK As Excel.Workbook
Dim oSH As Excel.Worksheet
Dim oWH As Object
Dim sFileName As String

Set rsFrom = CurrentDb.OpenRecordset("社員", dbOpenSnapshot) 'クエリ名は出力したいのに適宜変更
Set oXL = New Excel.Application
Set oBK = oXL.Workbooks.Add
Set oSH = oBK.Worksheets(1)
Set oWH = CreateObject("Wscript.Shell")

sFileName = oWH.specialfolders("DeskTop") '此処でデスクトップのPathを得ています。
sFileName = sFileName & "\" & "★.xlsx"

oSH.Range("A4").CopyFromRecordset rsFrom

oBK.SaveAs fileName:=sFileName
oBK.Close SaveChanges:=False
oXL.Quit

Set oWH = Nothing
rsFrom.Close: Set rsFrom = Nothing
Set oSH = Nothing
Set oBK = Nothing
Set oXL = Nothing

補足

ご回答いただき有り難うございます。当方不手際ならご容赦下さい、うまく動作しないようです。宜しくご指導下さい