パスワード自動付与で構文エラー

Question

エクセルVBAを利用してエクセルファイルに自動でパスワードを付与したいです。

パスワードを付与したいいくつかのエクセルファイルを格納したフォルダを用意

マクロを組んだsheet1のA列にファイル名　B列に付与したいパスワードを記入

マクロに下記を組む

Sub パスワード設定()

Application.ScreenUpdating = False

Dim filepath As String
Dim buf As String
Dim i As Long
Dim wb As Workbook

With Worksheets("Sheet1")

filepath = [パスワードを設定するファイルがある場所のパス]

buf = Dir(filepath &"*.xlsx")

Application.DisplayAlerts = False

Do While buf <>""Workbooks.Open (filepath &""&buf)
Set wb = Workbooks(buf)

For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If wb.Name Like ""&.Cells(i, 1).Value &""Then
ActiveWorkbook.SaveAs Filename:=filepath &""&buf, FileFormat:=xlOpenXMLWorkbook, _
Password:=WorksheetFunction.VLookup(.Cells(i, 1), .Range(.Cells(1, 1), .Cells(i, 2)), 2, False)
End If
Next i
Workbooks(buf).Close
buf = Dir()
Loop

End With
Application.DisplayAlerts = True

Application.ScreenUpdating = True
MsgBox "完了しました"End Sub

必ずDo Whileで構文エラーを吐きます、、、
どこがわるいのでしょうか？
助言頂ければ幸いです。

Answer 1

こんにちはこんばんは。よろしくおねがいいたします。
これ、そんなに難しく考えなくていいですよ。A列にファイル名が書いてあって、そのすぐ右のセルには必ず指定のパスワードがあるわけですから、VLOOKUPする必要はないと思います。

こういうシートがあるとして、

これのA列を、A2から順にナメていき、そのファイルを開き、このシートのすぐ右にある所定のパスワードで保存する、ということなら・・・

Option Explicit

Sub SaveAsNewPassword()

　　Dim myFileName As String
　　Dim MyNewPassword As String

　　Dim FilePath As String
　　FilePath = "C:¥temp¥myfolder¥"

　　Dim r As Range

　　'警告メッセージを出さなくさせる
　　Application.DisplayAlerts = False

　　For Each r In Range("A2", Range("A1").End(xlDown))
　　  'A列の情報がファイル名
　　  myFileName = r.Value
　　  'そのすぐ右隣りがパスワード
　  　MyNewPassword = r.Offset(0, 1).Value

　　  Workbooks.Open _
     Filename:=FilePath & myFileName

　　  ActiveWorkbook.SaveAs _
　　     Filename:=FilePath & myFileName, _
　　     Password:=MyNewPassword

　　  ActiveWorkbook.Close
        
　　Next r

　　'警告メッセージを元に戻す
　　Application.DisplayAlerts = True

End Sub

これで私のほうで実験してみて、うまくいきました。
お役に立てれば・・・

Comments

[benkyo]

さっさくのご回答ありがとうございます！
本当に申し訳ないのですがアプリケーションエラー　アプリケーション定義または〜のエラーが出ます。

根本的なことになってすみません。
パスワードを設定してないエクセルファイルを数個用意して１つのフォルダに入れる。

エクセルを開きエクセルシート1にフォルダに入れたファイル名とパスワードを頂きました画像のように入れる。

フォルダパスを教えて頂きましたvbaのfilepathの部分に入れる。

実行する。

これであってますでしょうか？

[AkiSaito]

"アプリケーション定義または..."ということは"1004"のエラーですね？
この1004は、すごくざっくりしたエラーなんです。
どこかの文字が「たった１文字間違ってる」みたいな、すごく細かいところが間違っているんだと思います。辛抱強く探してみる必要があります。がんばってください。

で、準備の内容と、実行の方法は、あなたの理解で正しいです。

実験してみるときは、VBEでF8キーを押して、ステップ実行してみるといいです。

またなにかありましたら、ご遠慮なくお問い合わせください！

[benkyo]

いろんなパターンで試してみましたが何故か同じエラーを吐き出します。ちょっと根本的な知識不足ですので一文一文理解できるように見直します！