vba只能给03版本的Excel文件加密，07的加密文件就损坏，帮看看什么问题

zc403512688

Sub 加密()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For i = 2 To Range("A65536").End(3).Row
        FLE = ThisWorkbook.Path & "\" & Cells(i, 1) & ".xls"
        PW = Cells(i, 2)
        RW = Cells(i, 3)
        With Workbooks.Open(FLE)
            .SaveAs Filename:=FLE, FileFormat:=xlNormal, Password:=PW, WriteResPassword:=RW
            .Close
        End With
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "处理完毕!"
End Sub

这个vba只能给03版本的Excel文件加密，07的加密文件就损坏了，打不开加密的文件，找不到问题。这个是是设置了两个密码了。工作表和工作表的。帮看看什么问题。大神帮提提修改意见或者帮改一下。谢谢了

3190496160

看你目前的代码，只能打开03版本的文件的吧

ykcbf1100

问题应该是出在下面这句代码上吧，你限定死了文件后辍为xls文件
FLE = ThisWorkbook.Path & "\" & Cells(i, 1) & ".xls"

abc3479

FLE = ThisWorkbook.Path & "\" & Cells(i, 1) & ".xls*"

zc403512688

3190496160 发表于 2024-8-5 09:19
看你目前的代码，只能打开03版本的文件的吧

07版本的文件用这个代码处理，加密的话就废了。就是文件打不开了，损坏的了。连输入密码都没跳出来

zc403512688

abc3479 发表于 2024-8-5 09:30
FLE = ThisWorkbook.Path & "\" & Cells(i, 1) & ".xls*"

不行。尝试过，07版本的文件经过处理还是会损坏掉。无法使用

zc403512688

这是代码源码，以及附件，各位大神帮看看怎么改。能同时给03和07版本的Excel文件加密，谢谢了

ykcbf1100

zc403512688 发表于 2024-8-5 15:21
这是代码源码，以及附件，各位大神帮看看怎么改。能同时给03和07版本的Excel文件加密，谢谢了

可以了，附件供参考。。。
关键在于把xls和xlsx文件分开处理。

ykcbf1100

批量给工作簿加上打开密码和修改密码

1. Sub ykcbf()    '//2024.8.5     工作簿加密
   
2.     Dim fn, wb
   
3.     Application.DisplayAlerts = False
   
4.     Application.ScreenUpdating = False
   
5.     Set fso = CreateObject("Scripting.FileSystemObject")
   
6.     Set d = CreateObject("Scripting.Dictionary")
   
7.     p = ThisWorkbook.Path & ""
   
8.     r = Cells(Rows.Count, 1).End(3).Row
   
9.     For i = 2 To r
   
10.         s = Cells(i, 1)
    
11.         If s <> Empty Then d(s) = Array(Cells(i, 2), Cells(i, 3))
    
12.     Next
    
13.     For Each f In fso.GetFolder(p).Files
    
14.         If LCase$(f.Name) Like "*.xls*" Then
    
15.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
16.                 fn = fso.GetBaseName(f)
    
17.                 fx = fso.GetExtensionName(f)
    
18.                 If InStr(fx, "xlsx") Then mm = 51 Else mm = 56
    
19.                 If d.exists(fn) Then
    
20.                     PW = d(fn)(0)
    
21.                     RW = d(fn)(1)
    
22.                     With Workbooks.Open(f)
    
23.                         .SaveAs Filename:=f, FileFormat:=mm, Password:=PW, WriteResPassword:=RW
    
24.                         .Close
    
25.                     End With
    
26.                 End If
    
27.             End If
    
28.         End If
    
29.     Next f
    
30.     Application.DisplayAlerts = True
    
31.     Application.ScreenUpdating = True
    
32.     MsgBox "处理完毕!"
    
33. End Sub
    

复制代码

zc403512688

ykcbf1100 发表于 2024-8-5 17:04
批量给工作簿加上打开密码和修改密码

可以了，非常感谢大神的鼎力相助，膜拜