[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロで複数のファイルに、ファイル毎に指定のパスワードを設定したい』（nijiniji）
毎月作成している月次データexcelのファイル約３０に対し、パスワードの指定をして 登録したい。パスワード設定後メール配信した後、来月のデータを取り込む為に パスワードをはずしたい。
大まかな形としては、フォルダに
３０ファイル （ファイル名は固定）
111-1111.xls
～
130-1130.xls
パスワード設定用ファイルに、上記３０のファイル名と指定のパスワードを入力して おきパスワード設定マクロを実行・パスワード解除マクロを実行。 というような構想なのですが、
Sub set_passwd()
Dim strBookName As String
strBookName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
Filename:=strBookName, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
End Sub
上記マクロを見つけてきましたが、これだと１ファイル毎に設定し、パスワード その都度入れたり、削除したりと入力待ちがいが発生してファイルを開けなくなり そうなのでなんとか、自動にしたいのですが。ここまでくるとシステムにならざる をえないのでしょうか。 ご教授下さい。
Excel2002 WindowsXP
>111-1111.xls > ～ >130-1130.xls
だと３０ファイルにならないですよね？
101-1101.xls
～
130-1130.xls
だと仮定して
元のブックにパスワードを設定するのではなくて 最初に選択したフォルダ内にサブフォルダを作って、その中に パスワード付きのブックを新規作成するサンプルです。 ヘルプなどを使って調べてみてください。
Sub test()
Const myPass As String = "1234" 'パスワード
Dim myPath As Object
Dim strFileName As String, LoadPath As String, WritePath As String
Dim i As Long
Set myPath = CreateObject("Shell.Application").BrowseForFolder(0, "ブックがあるフォルダを選択", 17)
If myPath Is Nothing Then Exit Sub
LoadPath = myPath.Items.Item.Path & "\"
WritePath = LoadPath & "PasswordFiles\"
MkDir WritePath
Application.ScreenUpdating = False
For i = 1 To 30
strFileName = Format(i, "100") & Format(i, "-1100") & ".xls"
With Workbooks.Open(LoadPath & strFileName)
.SaveAs WritePath & strFileName, Password:=myPass
.Close False
End With
Next i
Application.ScreenUpdating = True
MsgBox "完了"
End Sub
（ｍｏｍｏ）
早々のご教示ありがとうございます。 正直申しまして、自分の都合に合うマクロをそのままパクッて使った事しかないので コードを理解していません。 上記コードとサブフォルダを作ってやってみましたが、 パス名が無効のエラーとなってしまいました。 どこを直せばいいのでしょうか？
Const myPass As String = "1234" 'パスワード なぜここにパスワードなのでしょう？
ずうずうしいのですが見捨てず教えてくだされば・・・
(nijiniji)
サブフォルダはコード内で作っていますので作らなくて大丈夫です。
MkDir WritePath ここで作ってます。
>Const myPass As String = "1234" 'パスワード >なぜここにパスワードなのでしょう？ コード内で直接指定しても構いませんが、可読性と設定しやすさで Constで最初に設定しているだけですので なぜ・・・というより、では逆にどのようにパスワードを設定したいのでしょうか？
（ｍｏｍｏ）
>Const myPass As String = "1234" 'パスワード >なぜここにパスワードなのでしょう？ これだと３０ファイル全て同じパスワードになるのではないのですか？
>なぜ・・・というより、では逆にどのようにパスワードを設定したいのでしょうか？ 初回の説明不足のようで・・・
こちらの大構想なのですが・・・
①月次報告フォルダ の中にある 顧客別実績３０ファイルに 101-1101.xls 102-1102.xls ～ 129-1129.xls 130-1130.xls ②パスワード設定マクロ.xls このファイルは、①と同じ中でもサブフォルダの中でもどこでもいいです。 ②ファイルには、Ａ列に、①月次報告フォルダと同じファイル名。 Ｂ列に、パスワードを入力。 101-1101.xls 1234 102-1102.xls akb48 ～ 129-1129.xls tky123PO 130-1130.xls 130-1130
マクロを実行をすると、①のフォルダを順番に検索し、②のファイルＡ列と同じ名前が 有ったら、Ｂ列のパスワードを設定。なければ何もしない。 となるように、①フォルダのファイルに指定のパスワードを設定したいのです。 ①のファイル数と、②の入力数は同じではありません。顧客によって設定・非設定の要望が あるので。 また、この作業は毎月行うので、設定したのち（顧客に送付後） 来月のデータを取込むため、パスワードを解除するまでのマクロをにしたいのです。
高望みしすぎだと思いますが・・・
(nijiniji)
そいういう事ですか。 ですと殆どのコードが変更になりますが
Sub パスワード設定() SetPassWord True End Sub
Sub パスワード解除() SetPassWord False End Sub
Sub SetPassWord(flgPass As Boolean)
Dim objPath As Object, strPath As String
Dim tbl As Variant, i As Long
Dim LoadPass As String, WritePass As String
Set objPath = CreateObject("Shell.Application").BrowseForFolder(0, "ブックがあるフォルダを選択", 17)
If objPath Is Nothing Then Exit Sub
strPath = objPath.Items.Item.Path & "\"
tbl = ActiveSheet.Range("A1").CurrentRegion.Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To UBound(tbl)
If Dir(strPath & tbl(i, 1)) <> "" Then
If flgPass = True Then
LoadPass = "": WritePass = tbl(i, 2)
Else
LoadPass = tbl(i, 2): WritePass = ""
End If
With Workbooks.Open(strPath & tbl(i, 1), Password:=LoadPass)
.Save
.SaveAs strPath & tbl(i, 1), Password:=WritePass
.Close False
End With
End If
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "完了"
End Sub
パスワード設定を動かすと設定されて、解除を動かせば解除されます。
（ｍｏｍｏ）
ｍｏｍｏさん 連絡が遅くなり失礼いたしました。 望んでいた通り、パスワード設定・解除が出来ました。 ありがとうございました。
おんぶに抱っこで申し訳ありません。
「①月次報告フォルダ」の階層が深いので、フォルダの指定をしたいのですがその場合、
５行目、
Set objPath = CreateObject("Shell.Application").BrowseForFolder
(0, "ブックがあるフォルダを選択", 17) を
Set objPath = Dir(ActiveWorkbook.Path + "\①月次報告フォルダ\") にすると、１行目が型エラーになります。 Dir は、文字列型 (String) ですが、どこをどう直せばいいのかわかりません。
どうかご教授下さい。
(nijiniji)
>Set objPath = CreateObject("Shell.Application").BrowseForFolder(0, "ブックがあるフォルダを選択", 17)
>If objPath Is Nothing Then Exit Sub
この２行をコメントアウトしておいて
>strPath = objPath.Items.Item.Path & "\"
を
strPath = ActiveWorkbook.Path + "\①月次報告フォルダ\"
にすればできると思いますが Dir関数を使う意味はないと思いますが
ちなみにフォルダが無い場合はエラーになります。 （ｍｏｍｏ）
上記、マクロの一部訂正をしましたが、
「ファイルが見つかりません」のエラーになりました。
１から１０まですみません。 (nijiniji)
>ちなみにフォルダが無い場合はエラーになります。 という結果ですよね？
もしかして「①月次報告フォルダ」をルートとしてフォルダ指定をしたいという事ですか？
その場合は以下のように変更で。
Set objPath = CreateObject("Shell.Application").BrowseForFolder(0, "ブックがあるフォルダを選択", 17, ActiveWorkbook.Path + "\①月次報告フォルダ\")
If objPath Is Nothing Then Exit Sub
strPath = objPath.Items.Item.Path & "\"
（ｍｏｍｏ）
ｍｏｍｏさん また言葉足らずですみません。
①月次報告フォルダ は、また別のフォルダ「法人別報告ファイル」に、
「法人別報告ファイル」は、「2010利用実績」のフォルダの中というように、何階層にもなる
社内専用のファイルサーバに入っています。通常デスクトップからショートカットーキーで、
①月次報告フォルダ まで掘り下げて入っていきます。
上記マクロだと、「フォルダの参照」になりショートカットキーに入れません。
（今は試作中でデスクトップにフォルダを置いているので問題ありませんが）
②パスワード設定マクロ.xls のマクロの実行を掛けたとき、①月次報告フォルダを
すぐに参照するようにしたいのです。
(nijiniji)
> Set objPath = CreateObject("Shell.Application").BrowseForFolder(0, "ブックがあるフォルダを選択", 17, ActiveWorkbook.Path + "\①月次報告フォルダ\")
の（）内の最後のパラメータが初期フォルダですので そこのパスを設定してあげるだけなのですが・・・
フォルダの選択に問題があるのですか？ ショートカットを選択するようにするにはファイル選択をしなければならないので 対象ファイルも全て選択するようにしなければなりません。
具体的にどのようにしたいのかが良くわかりません （ｍｏｍｏ）
ｍｏｍｏさん
いろいろとありがとうございます。
「ファイル名がみつかりません」の原因は、ｍｏｍｏさんに教えてもらってる時は 簡単なファイル名にしていました。正式ファイル名は長かった為、途中で切れてしまい ファイル名がない状態になっていました。
また、フォルダの指定については
>strPath = ActiveWorkbook.Path + "\①月次報告フォルダ\"
を
strPath = ActiveWorkbook.Path & "\"
にしたら上手くいきました。 （フォルダ名を入れると二重になってしまい、設定されない）
この解決は、職場の偉い方に教えてもらいました。 今回、仕事で大ミスを起こしてしまい、おおっぴらに相談も出来ず、 エクセルの学校に駆け込みました。 いつも人頼み・パクってばかりではダメですね。 毎回これを機にと思ってはいるのですが・・・
ｍｏｍｏさん、最後までありがとうございました。 また何かの時はよろしくお願いしますm(_ _)m (^_^;)
(nijiniji)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.