ここから本文です

アクセスのテーブル(部門名というフィールドを含む複数部門のデータ)を一括で複...

ale********さん

2014/1/1418:15:44

アクセスのテーブル(部門名というフィールドを含む複数部門のデータ)を一括で複数エクセル(部門ごとのエクセルファイル)に、パスワード付でエクスポートする方法を教えて下さい。

パスワードなしの複数エクセルの作成については、「アクセスのテーブルを一括で複数エクセルにエクスポートする方法を教えてください。」のご質問に対する、2010/9/19 07:37:42のmi_no_ho_do_si_ra_zu様の下記のご回答を参考に、エクスポートするところまではできております。
こちらにパスワードをつけて保存できるようにしたいです。
アクセス初心者です。どうぞよろしくお願い致します。

Sub SAMPLE()
Dim DB As Database
Dim R1 As Recordset
Dim Q1 As QueryDef
Dim SQL_Txt As String
'データベースを参照
Set DB = CurrentDb()
'作業用クエリを作成
Set Q1 = DB.CreateQueryDef("Q_" & Format(Now, "yyyymmddhhnnss"))
'テーブルの部門名の一覧を取得
SQL_Txt = "SELECT DISTINCT 部門名 FROM テーブル1"
Set R1 = DB.OpenRecordset(SQL_Txt)
'一覧にある部門名ごとに処理
R1.MoveFirst
Do Until R1.EOF
'クエリの書き換え(SQLのセット)
Q1.SQL = "SELECT * FROM テーブル1 WHERE 部門名='" & R1!部門名 & "'"
'エクスポート
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Q1.Name, Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & R1!部門名 & ".xls"
R1.MoveNext
Loop
'作業用クエリの削除
DoCmd.DeleteObject acQuery, Q1.Name
End Sub

補足>nekoman2012様、
どうもありがとうございました。
後者の方法(再読込)を試したいのですが、毎回exportされるfileの数と名前が違うことから(総務140115.xlsx,法務140115.xlsxの2件、次の日は、法務140116.xlsx,営業140116.xlsx,人事140116.xlsxの3件(質問に明記せず申し訳ありません))、保存したfolder内の全てのfileに処理を行う方法が良いかと思っております(?)。もう少しヒントとなるcodeなどご教示頂けますでしょうか。

閲覧数:
499
回答数:
2
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

yc_********さん

2014/1/1618:17:02

提示されてるコードに上乗せしてみました。
元からついてた注釈を取り除き、今回の件についての分を注釈記入してます。

Sub SAMPLE()

Dim PW As String 'パスワード記憶変数
Dim TgtFile As String 'ターゲットファイル名記憶変数
Dim ObjEx As Object '作業用のExcel

Dim DB As Database
Dim R1 As Recordset
Dim Q1 As QueryDef
Dim SQL_Txt As String

PW = "ABC" 'とりあえずパスワード設定
Set ObjEx = CreateObject("Excel.Application") 'あらかじめExcelを起動

Set DB = CurrentDb()
Set Q1 = DB.CreateQueryDef("Q_" & Format(Now, "yyyymmddhhnnss"))
SQL_Txt = "SELECT DISTINCT 部門名 FROM テーブル1"
Set R1 = DB.OpenRecordset(SQL_Txt)
'R1.MoveFirst 'レコード件数が0件だとエラーするので省く
Do Until R1.EOF
Q1.SQL = "SELECT * FROM テーブル1 WHERE 部門名='" & R1!部門名 & "'"

TgtFile = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & R1!部門名 & ".xls"
If Dir(TgtFile) <> "" Then Kill TgtFile 'パス付きExcelに出力するとエラーするのでファイルを削除してみる(余計なお世話?)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Q1.Name, TgtFile

'--- ここから核心
ObjEx.Workbooks.Open (TgtFile) '上で作成したファイルを読み込む
ObjEx.Worksheets(Q1.Name).Select
ObjEx.Application.DisplayAlerts = False '確認メッセージオフ
ObjEx.ActiveWorkbook.Saveas FILENAME:=TgtFile, Password:=PW 'パスワード付きで保存する
ObjEx.Application.DisplayAlerts = True '確認メッセージオン
'--- ここまで

R1.MoveNext
Loop
DoCmd.DeleteObject acQuery, Q1.Name

ObjEx.Application.Quit '後始末1
Set ObjEx = Nothing '後始末2

End Sub


EXCEL連携が得意ではないですが、これで行けそうです。

質問した人からのコメント

2014/1/17 16:37:53

感謝 こちらで完璧に動きました!!どうもありがとうございました。とても助かりました。こちらを参考にさせて頂いて、取り組みたいと思います。本当に、どうもありがとうございました。

ベストアンサー以外の回答

1〜1件/1件中

nek********さん

2014/1/1604:20:20

TransferSpreadsheet acExportではパスワード設定はできなかったと思います。
CreateObjectでファイル作成⇒データ出力し、SaveAsでPasswordを設定するのがスマートかと。

今のままでもacExport後にGetObjectで再読込し、SaveAsで設定できるかと思います。

あわせて知りたい

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる