Accessにおけるパスワード一括解除について

質問

指定のフォルダにあるエクセルブックをアクセスにて一括解除してそのままAccessにインポートする方法を探しています。
vba初心者なのでコードも頂けると助かります。

回答No.1

NuboChan

過去レスに同じような質問が合った。
https://okwave.jp/qa/q294748.html

補足

説明が足りず申し訳ありません。
現状としましては指定のフォルダに複数のパスワード付きファイルが存在し、最初の1つはパスワード解除に成功するのですが2個目以降の処理が上手く行きません。(終了と出るのですが解除されるのは1つのみです。)
現在ネット等を参考にこのようなコードを書いているのですが何処に原因があるか不明なためご教示頂きたいと思っております。
Private Sub passreset_Click()

Dim DB As Database
Dim RC As DAO.Recodset
Dim RB As DAO.Recodset
Dim RN As DAO.Recodset
Dim RP As DAO.Recodset
Dim SQL_TxtC As String
Dim SQL_TxtB As String
Dim SQL_TxtN As String
Dim SQL_TxtP As String
Dim strDocName As String
Dim strNewName As String
Dim oApp As Object
Dim FLD_NAME As String
Dim fname As String

Set DB = CurrentDb()
SQL_TxtC ="SELECT DISTINCT 地区 FROM マスタ"
SQL_TxtB ="SELECT DISTINCT 部署 FROM マスタ"
SQL_TxtN ="SELECT DISTINCT 番号 FROM マスタ"
SQL_TxtC ="SELECT DISTINCT パスワード FROM パスワード"
Set RC = DB.OpenRecordset(SQL_TxtC)
Set RB = DB.OpenRecordset(SQL_TxtB)
Set RN = DB.OpenRecordset(SQL_TxtN)
Set RP = DB.OpenRecordset(SQL_TxtP)

FLD_NAME = "¥¥～sample¥" & RC!地区 & "¥" & RB!部署 & "¥"

strDocName = FLD_NAME & RN!番号 & ".xls"
strNewName = FLD_NAME & RN!番号 & "パス無し" & ".xls"
Set oApp = CreateObject("Excel.Application")
fname = Dir(strDocName)

'Excelファイルオープン
With oApp
.Workbooks.Open FileName:=strDocName,Password:=RP!パスワード,WriteResPassword:=RP!パスワード

'名前をつけて保存
.Visible = False
.ActiveWorkbook.SaveAs strNewName,Password:="",WriteResPassword:=""
.ActiveWorkbook.Close False
.Quit
End With
Set oApp = Nothing
Do While fname 〈〉 ""
Loop

MsgBox "終了"

End Sub