ACCESSからExcelへエクスポート時にパスワードを自動設定したい。

質問

お世話になっております。
ACCESSからExcelへエクスポート時にパスワードを自動設定したいのですが、教
えていただけませんでしょうか。
Office2000
WindowsXP
下記のように「Excel出力」ボタン（クリック時）のイベントプロシージャに設
定しております。なお、これも色々なところから探した式で、あまり得意でない
ので、具体的な式を教えていただけると助かります。
コピペして何とか作った式だけに、何だか要らない行がある気もしますし。。。

「Excel出力」ボタンをクリックすると、「OKorキャンセル」ウインドウが出て、
「OK」ならば「元DB」というクエリを「出力後DB」の後に日時を付加したExcel
ファイルを生成。「キャンセル」ならば何も生成しない、という式になってます。
「\\***\***\***\」は保存先フォルダのパスを指します。これは毎回同じところ
で良いです。
これを、生成後のファイルに毎回決まった、又はその都度設定するパスワード（
Excel上の全般オプションの開く時）を自動的に設定したいです。

-----
Private Sub Excel出力_Click()

On Error GoTo Err_Excel出力_Click

Dim newFile As Double
Dim strPath As String
Dim srchXls As String
newFile = Val(Format(Date, "yyyymmdd") & Format(0, "00"))

Do
newFile = newFile + 1
strPath = "出力後DB_" & Mid(newFile, 3, 6) & "_" & Right(newFile, 2) & ".
xls"
srchXls = "\\***\***\***\出力後DB_" & Format(Now(), "yymmdd_hhnnss") & ".
xls"

Loop Until strPath <> Dir(srchXls, vbNormal)

Select Case MsgBox(srchXls & "を作成しますか？", vbOKCancel)
Case vbOK
DoCmd.TransferSpreadsheet acExport, , "元DB", srchXls, True
MsgBox (srchXls & Chr(13) & Chr(10) & "を作成しました。")

Case Else
Exit Sub
End Select

Exit_Excel出力_Click:
Exit Sub

Err_Excel出力_Click:
MsgBox Err.Number & Err.Description
Resume Exit_Excel出力_Click

End Sub
-----

と、ここまで書いてなんですが。。。
予めパスワードの掛った別のmdbファイルの既存のテーブルにインポートする
やり方があれば、挑戦してみようと思ってます。

以上、長くなりましたが宜しくお願いいたします。

回答No.1

nicotinism · ベストアンサー

一旦 XLSファイルを出力後にパスワードの設定を行う事になります。
> DoCmd.TransferSpreadsheet acExport, , "元DB", srchXls, True
> MsgBox (srchXls & Chr(13) & Chr(10) & "を作成しました。")

の後にオートメーションで開いて処理の流れかと思います。

Dim xlsAp As Object
Dim xlsBK As Object

Set xlsBK = GetObject(srchXls)
Set xlsAp = xlsBK.Application
xlsBK.Windows(1).Visible = True
xlsAp.DisplayAlerts = False
xlsBK.SaveAs FileName:=srchXls, Password:="abc"
xlsAp.DisplayAlerts = True
xlsAp.Quit
Set xlsBK = Nothing
Set xlsAp = Nothing

後半の質問はこちらをどうぞ
http://x7net.com/~access/AcTipsGnrlHowToAttachExternalMdb.html#DCTD

お礼

おおおお！
すごいです。できました！
長いこと悩んで色んなところを探してたのですが、良い方法が見つからず、あきらめかけていました。
本当にありがとうございます。
大感謝です！！