[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数ファイルに同一のパスワードを設定』(yuki)
同一フォルダ内にある複数のファイル(300個ほど)に同一の読み込みパスワードを設定したのですが、マクロで良い方法がありますでしょうか。
初心者につきよろしくお願いいたします。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
メモ帳で新規メモを開いて、
Dim n, w
Dim appEX, mBook
Dim appWD, mDoc
Dim nPassword
Dim fString
Dim L
Dim LL
Dim B()
If WScript.Arguments.Count = 0 Then
MsgBox "ファイルがドラッグアンドドロップされていません。" Else nPassword=InputBox("設定パスワードを入力してください。","") If IsEmpty(nPassword) = True Then MsgBox "キャンセルが選択されました" Else On Error GoTo 0 Set appEX = CreateObject("Excel.Application") appEX.ScreenUpdating = False appEX.DisplayAlerts = False appEX.EnableEvents = False
For Each n In WScript.Arguments w = Right(n, 4) If w = ".xls" Or w = "xlsx" Or w = "xlsm" Then With appEX .WindowState = -4137 'xlMaximized Set mBook = .Workbooks.Open(n,0) mBook.SaveAs n,,nPassword mBook.Close End With End If Next appEX.EnableEvents = True appEX.DisplayAlerts = True appEX.ScreenUpdating = True appEX.Quit
On Error GoTo 0 MsgBox "処理終了しました" End If End If
として、名前を「test.vbs」とかにして下さい。
そのアイコンの上に選択したExcelファイルをドラッグ&ドロップすると指定したパスワードが
設定されます。
同一フォルダならこんな程度でいいかと思います。
増えたファイルはその都度、ドラッグ&ドロップすればいいですし。
(ウッシ) 2015/06/30(火) 07:40
To ウッシさん
失礼します。
・If w = ".xls" Or w = "xlsx" Or w = "xlsm" Then
実際には問題ないでしょうが、拡張子が .XLS や .XLSX や .XLSM の場合は、空振りすると思いますので 念のため、LCase や UCase で処理したものを使うほうが安全かもしれませんね。
・.WindowState = -4137 'xlMaximized
後学のために教えてください。最大化する理由は何でしょうか? 指定しなくても、あるいは、-4140 (xlMinimised) を指定しても、パスワードはセットできると思うのですが?
(β) 2015/06/30(火) 09:21
そうですね、
w = LCase(Right(n, 4))
に変更しないとダメですね。
最大化は消し忘れです。
(ウッシ) 2015/06/30(火) 09:32
ウッシさんのコードを、そのままお借りして、通常のVBA処理コードにすると以下のようなものになると思います。 変換したいブックが入っているフォルダに、このマクロブックを保存して実行してください。
なお、InputBox関数の戻り値はString型なので、キャンセルボタン押下時は、"" が返り、IsEmpty ではチェックできないと思いますので "" かどうかの判定にしてあります。
Sub Test() Dim fPath As String Dim fName As String Dim nPassword As Variant Dim mBook As Workbook
nPassword = InputBox("設定パスワードを入力してください。", "") If nPassword = "" Then MsgBox "キャンセルが選択されました" Exit Sub End If
Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xls*")
Do While fName <> "" If fName <> ThisWorkbook.Name Then '自分自身は除く Set mBook = Workbooks.Open(fPath & fName) mBook.SaveAs fPath & fName, , nPassword mBook.Close End If fName = Dir() Loop
Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False
MsgBox "処理終了しました"
End Sub
(β) 2015/06/30(火) 09:46
>・If w = ".xls" Or w = "xlsx" Or w = "xlsm" Then 今回の場合はまず大丈夫とは思うが拡張子のチェックをする場合は「.」以降を抜き出すほうがいいのでは?
もし、「.axlsx」などという拡張子があった場合、左から4桁抜き出しだと「xlsx」と区別がつかない。 (ねむねむ) 2015/06/30(火) 09:51
参考HPです。 Excel2007の拡張子一覧 http://www.relief.jp/itnote/archives/003000.php (カリーニン) 2015/06/30(火) 09:55
修正した方がいいところ有ったらどんどん修正したコードをアップして下さい。
(ウッシ) 2015/06/30(火) 09:57
>>「.」以降を抜き出すほうがいいのでは?
FSO、あるいは、以下でも抜出できますね。(21:12 もう1例追加)
Sub Test() Dim s As String Dim n As Long Dim w As Variant
s = "abcd.xyz.jkl"
MsgBox Mid(s, InStrRev(s, ".") + 1)
MsgBox StrReverse(Split(StrReverse(s), ".")(0))
w = Split(s, ".") MsgBox w(UBound(w))
End Sub
(β) 2015/06/30(火) 12:13
早速やってみます。
また、HELPのときはよろしくお願いします。
(yuki) 2015/07/01(水) 19:07
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.