Tự động đặt pass cho nhiều files excel

[bigbabol89]

Em chào các anh chị,
Em có 1 folder nhiều file excel khác nhau ( 500 files ), em muốn đặt pass cho mỗi file excel là 1 pass khác nhau.
Dữ liệu điều kiện đặt pass như sau :
- Cột A2 là tên file excel
- Cột B2 là pass excel tương ứng.
Mong các anh chị giúp đỡ em. Em cám ơn ạ.
Ps : Em không biết là dùng excel có đặt đc pass cho file pdf hay ko ? Nếu đặt đc cho file pdf thì mong các anh giúp em, nếu ko dc thì file excel cũng tốt lắm rồi ạ.

 

[Hau151978]

Bạn thử xem có ghi macro được đối với 1 file không: bật ghi macro, mở 1 file khác đặt password rồi đóng file đó. Nếu ghi được macro thì xử lý tiếp không khó.

 

[bigbabol89]

Bạn thử xem có ghi macro được đối với 1 file không: bật ghi macro, mở 1 file khác đặt password rồi đóng file đó. Nếu ghi được macro thì xử lý tiếp không khó.

Hì hì, em ko biết dùng code macro

 

[Hau151978]

Hì hì, em ko biết dùng code macro

Vậy để bạn khác giúp. Mình online trên điện thoại nên không thử được.

 

[giaiphap]

Em chào các anh chị,
Em có 1 folder nhiều file excel khác nhau ( 500 files ), em muốn đặt pass cho mỗi file excel là 1 pass khác nhau.
Dữ liệu điều kiện đặt pass như sau :
- Cột A2 là tên file excel
- Cột B2 là pass excel tương ứng.
Mong các anh chị giúp đỡ em. Em cám ơn ạ.
Ps : Em không biết là dùng excel có đặt đc pass cho file pdf hay ko ? Nếu đặt đc cho file pdf thì mong các anh giúp em, nếu ko dc thì file excel cũng tốt lắm rồi ạ.

Tranh thủ 15 phút nghỉ hiệp 1 viết code cho bạn.

Sub Set_Pass()
Dim Item
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Excel File", "*.xls*", 1
    If Not .Show = -1 Then
        MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
        Exit Sub
    End If
On Error Resume Next
Application.DisplayAlerts = False
For Each Item In .SelectedItems
    With Workbooks.Open(Item)
        .SaveAs Password:="GPE"  ', WriteResPassword:=""
        .Close
    End With
Next Item
Application.DisplayAlerts = True
End With
End Sub

 

[bigbabol89]

Tranh thủ 15 phút nghỉ hiệp 1 viết code cho bạn.

Sub Set_Pass()
Dim Item
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Excel File", "*.xls*", 1
    If Not .Show = -1 Then
        MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
        Exit Sub
    End If
On Error Resume Next
Application.DisplayAlerts = False
For Each Item In .SelectedItems
    With Workbooks.Open(Item)
        .SaveAs Password:="GPE"  ', WriteResPassword:=""
        .Close
    End With
Next Item
Application.DisplayAlerts = True
End With
End Sub

Anh ơi, hình như code này set duy nhất 1 pass là GPE thôi thì phải. Nhưng mà ý em là mỗi file là 1 pass khác nhau theo file data có sẵn có cấu trúc :
Cột A : Tên file
Cột B : Tên pass
....
Anh xem giúp em với. ( 2-0 rồi ^^ )

 

[giaiphap]

Anh ơi, hình như code này set duy nhất 1 pass là GPE thôi thì phải. Nhưng mà ý em là mỗi file là 1 pass khác nhau theo file data có sẵn có cấu trúc :
Cột A : Tên file
Cột B : Tên pass
....
Anh xem giúp em với. ( 2-0 rồi ^^ )

Tốt nhất là có file mẫu thì sẽ tính tiếp còn nếu không có thì đợi các thành viên khác giúp bạn.

 

[bigbabol89]

Dạ đây anh ơi, em sorry.

 

[giaiphap]

Dạ đây anh ơi, em sorry.

Trước hết làm rõ 2 vấn đề.
Thứ nhất: File ở cột A nằm trong thư mục nào mới được chứ.
Thứ hai: Tên file không có phần mỡ rộng (.xls, .xlsx, .xlsm, .xlsb...) vậy lấy phần mỡ rộng là gid vậy?

 

[bigbabol89]

Trước hết làm rõ 2 vấn đề.
Thứ nhất: File ở cột A nằm trong thư mục nào mới được chứ.
Thứ hai: Tên file không có phần mỡ rộng (.xls, .xlsx, .xlsm, .xlsb...) vậy lấy phần mỡ rộng là gid vậy?

Em sorry, vì em cũng ko biết nhiều nên trình bay hơi dài dòng :
- File cột A : nằm ở ổ D, tên folder là “BCL”.
- Tên file là : xlsx
Thanks anh

 

[giaiphap]

Em sorry, vì em cũng ko biết nhiều nên trình bay hơi dài dòng :
- File cột A : nằm ở ổ D, tên folder là “BCL”.
- Tên file là : xlsx
Cảm ơn anh

Bạn sửa code lại thế này.

Sub Set_Pass()
Dim Arr(), i As Integer
On Error Resume Next
Arr = Sheet1.Range("A2:B" & Sheet1.Range("A65000").End(xlUp).Row).Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To UBound(Arr, 1)
    With Workbooks.Open("D:\BCL\" & Arr(i, 1) & ".xlsx")
        .SaveAs Filename:="D:\BCL\" & Arr(i, 1) & ".xlsx", Password:=Arr(i, 2)
        .Close
    End With
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Da dat xong mat khau", vbInformation, "---GPE---"
End Sub

 

[VetMini]

Em sorry, ...

??? tây bồi
apologize/ise mới là động từ
I'm sorry; My apologies; hoặc là My bad

 

[bigbabol89]

Bạn sửa code lại thế này.

Sub Set_Pass()
Dim Arr(), i As Integer
On Error Resume Next
Arr = Sheet1.Range("A2:B" & Sheet1.Range("A65000").End(xlUp).Row).Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To UBound(Arr, 1)
    With Workbooks.Open("D:\BCL\" & Arr(i, 1) & ".xlsx")
        .SaveAs Filename:="D:\BCL\" & Arr(i, 1) & ".xlsx", Password:=Arr(i, 2)
        .Close
    End With
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Da dat xong mat khau", vbInformation, "---GPE---"
End Sub

Em cám ơn. Code dùng rất tốt ạ.

 

[vyvy]

Chào các anh chị,

Em có 1 file tổng hợp danh số bán hàng của các bạn salesman bán hàng từng tháng đạt được .

Làm thế nào để mỗi bạn nhận được file chỉ xem được mỗi thông tin của mình mà không thấy được thông tin của các bạn salesman khác nhưng chỉ có một file nguồn tổng em gưi thôi ạ.

Nghĩa là em cần nhiều password theo cho từng bạn salesman khi đăng nhập file tổng này

Mong các anh chị giúp em với ạ.

Em cảm ơn

 

[busalam]

Bạn sửa code lại thế này.

Sub Set_Pass()
Dim Arr(), i As Integer
On Error Resume Next
Arr = Sheet1.Range("A2:B" & Sheet1.Range("A65000").End(xlUp).Row).Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To UBound(Arr, 1)
    With Workbooks.Open("D:\BCL\" & Arr(i, 1) & ".xlsx")
        .SaveAs Filename:="D:\BCL\" & Arr(i, 1) & ".xlsx", Password:=Arr(i, 2)
        .Close
    End With
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Da dat xong mat khau", vbInformation, "---GPE---"
End Sub

Anh ơi, chỉ em đặt pass tương tự cho file PDF với ạ