[[20150629233255]] 『複数ファイルに同一のパスワードを設定』(yuki) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数ファイルに同一のパスワードを設定』(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


ウッシさん、βさん、ねむねむさん
皆さんありがとうございます。o^ー^o
拡張子のチェックのところは難しいそうですね。

早速やってみます。
また、HELPのときはよろしくお願いします。
(yuki) 2015/07/01(水) 19:07


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.