アクセス テーブルデータをエクセル(パスワード付)に出力するマクロがうまくいきません。

お世話になります。初心者です。職場で、何度も何度も調整して、試しますが、解決できません。
うまくいくには、どこをどう直したらよいのか、または、他に、最適・最短なコードがあるのか、
どうか、ご指導くださいます様お願いいたします。
行き詰まっています！教えてください！よろしくお願いいたします！
職場で、何度も、大の字になって、天井を見たくなりました。

【問題】
①下記のコードがうまく動かない。
②なぜか出力予定先で、ファイル形式が、Excelバイナリデータ(全く分からない)になって保存できなかったりします。

【仕様】ボタンを押下すると、自動的に、すでに用意されているパスワード付エクセルへ
テーブルデータをエクスポートする。

【仕上がり目標】パスワード解除してエクスポート後、再び、パスワードをかけて、保存して閉じた後、ファイルを開きたい（パスワード聞かれる状態で終わりたい）。

【材料】
クエリ名　：入力結果一覧クエリ(下記のテーブルを作成クエリ)
テーブル名：入力結果一覧テーブル

エクセル名：入力結果一覧管理表.xlsx
(xlsだったり、xlsxになったり、その都度異なるのもなぜか分かりません。)
パスワード：　1234

以下は、私がいろいろと参考にして書いたコードです。。。
(恥ずかしいです。目的分からずに使っている可能性も多いにあります。）
やろうとしていたことは、
クエリを開いて、閉じて、テーブル作成しておいて、
E:\事務センター\業務課\データ\にある、入力結果一覧管理表.xlsxファイルのパスワードを解除して、解除した状態でエクセルを保存して、閉じておいて、
そのファイルに、作成したテーブルデータをエクスポートして、
エクセルファイルを開いた状態にする。
閉じた後、手動でパスワードをかけておいて、
毎回、このエクセルファイルを使って、上書き利用する、でした。。。

Private Sub エクセル出力_Click()

DoCmd.OpenQuery "入力結果一覧クエリ", acViewNormal, acEdit
DoCmd.Close acQuery, "入力結果一覧クエリ"

Dim strDocName As String
Dim strNewName
Dim oApp As Object

strDocName = "E:\事務センター\業務課\データ\入力結果一覧管理表.xlsx"
strNewName = "E:\事務センター\業務課\データ\入力結果一覧管理表.xlsx"

Set oApp = CreateObject("Excel.Application")

'Excelファイルオープン
With oApp
.Visible = True
.Workbooks.Open FileName:=strDocName, _
Password:="1234", WriteResPassword:="1234"

'名前を付けて保存
.ActiveWorkbook.SaveAs strNewName, Password:="", WriteResPassword:=""
.ActiveWorkbook.Close False
.Quit
End With
Set oApp = Nothing

'Excelへエクスポート

Dim tblName As Variant

tblName = "入力結果一覧テーブル"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, tblName, "E:\事務センター\業務課\データ\入力結果一覧管理表.xlsx", True

'Excelを起動する
Set oApp = CreateObject("Excel.Application")
oApp. Visible = True 'Excelを見えるようにする
On Error Resume Next
oApp. UserControl = True

oApp.workbooks.Open FileName:= "E:\事務センター\業務課\データ\入力結果一覧管理表.xlsx"

End Sub

質問者からの補足コメント

• 

  未だ解決していません。。。教えて頂いたり、みつけたコードを、つぎはぎして、動いたはずなのに、動かなくなって、一週間・・・です。
  明日も、また、格闘してきます。
  どうか、お助け頂ける方、お待ちしております。

    補足日時：2016/09/01 22:40

No.1 ベストアンサー 回答者： bonaron 回答日時： 2016/09/05 18:05

> 他に、最適・最短なコードがあるのか、

多分あるでしょう。
でも、こう訊かれると例を出しにくいです。
こんなんで最適かよ、と言われそうで。

●まず、現在のコードの明らかな間違いから。

xlsx に出力するには
acSpreadsheetTypeExcel12 ではなく acSpreadsheetTypeExcel12Xml です。
acSpreadsheetTypeExcel12 では xlsb を指定したことになります。

●次にちょっとしたことですが、
「テーブル作成クエリ」 で テーブルを作ってそれをエクスポートしていますが
「選択クエリ」をエクスポートすることも可能です。
何かそうしない、あるいはできない理由があるのでしょうか。

> DoCmd.OpenQuery "入力結果一覧クエリ", acViewNormal, acEdit
> DoCmd.Close acQuery, "入力結果一覧クエリ"

"入力結果一覧クエリ" が 「テーブル作成クエリ」ということなら
Close する必要はないと思われます。
これも何か理由がありますか？

更に、「テーブル作成クエリ」で、
テーブルを作ったり削除したりを繰り返すのは
データベースの破損につながる、と言われています。
「削除クエリ」と「追加クエリ」の組み合わせで置き換える場合が多いです。

●根本的な問題になりますが。
１度エクスポートするために
計３度エクセルファイルに書き込みする、これはいかにもわずらわしい。
不具合の原因になりそう。

Docmd は非同期処理ですから、出力が完了しないうちに
次のパスワード設定の処理に行ってしまうのでは？
データ量とか、ネットワーク上のファイルかなどで違ってくるでしょうが。


☆自分が作るとこんな感じ

Private Sub エクセル出力_Click()
Dim objXLS As Object
Dim objBook As Object
Dim objSh As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strDocName As String
Dim tblName As String

Dim i As Integer

strDocName = "E:\事務センター\業務課\データ\入力結果一覧管理表.xlsx"
tblName = "入力結果一覧選択クエリ"

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(tblName, dbOpenForwardOnly)

Set objXLS = CreateObject("Excel.Application")
Set objBook = objXLS.Workbooks.Open(FileName:=strDocName, _
Password:="1234", WriteResPassword:="1234")
Set objSh = objBook.Worksheets.Add

With objSh
For i = 0 To rst.Fields.Count - 1
.Cells(1, i + 1) = rst.Fields(i).Name
Next
.Cells(2, 1).CopyFromRecordset rst
.Name = "入力結果一覧テーブル"
End With

objXLS.Visible = True
objBook.Save
Set objXLS = Nothing
End Sub

この回答へのお礼

bonaronさま
おはようございます！
最適最短なコードって書きましたことについては、大変失礼しました。
言い方が悪かったです。私のつぎはぎコードの反対を意味するための表現でした。余計な言い方しました。

ところで、今日、職場で試そうと思います。
もう、できなくて、手作業でエクスポート対応をしてもらって、途方にくれていたところでした。。。

ありがとうございますっ！！！

お礼日時：2016/09/06 07:18