Excel VBA:将文件夹中多个受密码保护的工作簿中的数据复制到另一个工作台中的一个工作表中

时间:2016-01-07 09:25:14

标签: excel-vba vba excel

我编写了一个代码,用于在文件夹中打开受密码保护的工作簿,从中复制一些值并将值粘贴到活动的woorkbook中。这很好。

我的问题是我在这个文件夹中有16个受密码保护的文件,我需要一个循环,它对每个文件都做同样的事情。您可以在下面找到代码,我认为我的所有问题都应该通过代码中的注释正确解释。请问是否有任何不清楚的地方。提前,谢谢你的帮助!

代码:

Sub Bengt()
Dim sPath As String
Dim vFolder As Variant
Dim sFile As String
Dim sDataRange As String
Dim mydata As String
Dim wb As Workbook
Dim WBookOther As Workbook
Dim myArray As Variant  '<<does the list of passwords have to be array?


sPath = ThisWorkbook.Path & Application.PathSeparator
sDataRange = "Budsjett_resultat'!E2"  '<<every file I want to open has data in this sheet and range
sFile = "BENGT.xlsm"  '<< how to make sFile be every file in folder?


' here I want a loop that opens every woorkbook in the folder M::\SALG\2016\Budsjett\

Set WBookOther = Workbooks.Open(sPath & sFile, Password:="bengt123")
' all passwords starts with filename + three numbers after as you can see
' here I want to make excel find the password out of a list of passwords in range B100:B116
mydata = "='" & sPath & "[" & sFile & "]" & sDataRange

'mydata = "='M:\SALG\2016\Budsjett\Bengt.xlsmBudsjett_resultat'!E2:E54" '<< change as required

'link to worksheet
With ThisWorkbook.Worksheets(1).Range("T2:T54")
'in this case I want the loop to find "BENGT"(which is the filename) in cell T1, and paste the values in range T2:T54.
'For the other files, I want the loop to find the filename (of the file it opened) in row 1,
'and paste the values in range ?2-?54 at the column with the same name as the filename
.Formula = mydata
.Value = .Value
WBookOther.Close SaveChanges:=False

End With

End Sub

对于密码数组,我尝试过以下代码:

Sub passord()
Dim myArray As Variant
myArray = ThisWorkbook.Worksheets(1).Range("B100:B116")
On Error Resume Next  'turn error reporting off
For i = LBound(myArray, 1) To UBound(myArray, 1)
Set wb = Workbooks.Open("M:\SALG\2016\Budsjett\BENGT.xlsm", Password:=myArray(i, 1))
If Not wb Is Nothing Then bOpen = True: Exit For
Next i

End Sub
  • 我试图将最后一个子实现到第一个子,但我无法弄清楚如何使其工作。

0 个答案:

没有答案