Import module mới thay cho module cũ với vbaproject có pass

Liên hệ QC

phuoclocvl

Thành viên thường trực
Tham gia
28/3/12
Bài viết
220
Được thích
32
Chào các Anh Chị,
Xin giúp em vấn đề này, mình có code nào import một module mới trùng tên với module cũ và thay thế module cũ (replace) nhưng Vba project có cài password.
Xin cảm ơn ạ,
 
Dạ, em upload file lên các anh em hỗ trợ giúp.
Trong file có những module. em muốn gửi file này cho mọi người dùng và sẽ đặt password cho VBAproject, khi nào có thay đổi thì em sẽ cho update 1 trong những module này. có cách nào update new module thay thế module cũ mà với project đã cài password không.
mục đích là vậy.
xin cảm ơn ạ.
 

File đính kèm

  • Sample_File.xlsb
    1.7 MB · Đọc: 3
Upvote 0

File đính kèm

  • Data Update Revision.zip
    673.3 KB · Đọc: 10
Lần chỉnh sửa cuối:
Upvote 0
Dạ, em upload file lên các anh em hỗ trợ giúp.
Trong file có những module. em muốn gửi file này cho mọi người dùng và sẽ đặt password cho VBAproject, khi nào có thay đổi thì em sẽ cho update 1 trong những module này. có cách nào update new module thay thế module cũ mà với project đã cài password không.
mục đích là vậy.
xin cảm ơn ạ.
Tôi không tải file bạn, nhưng bạn xem file tôi viết có thể áp dụng cho file của mình được hay không? Trong file có tham khảo code ở link sau:
 

File đính kèm

  • Project_IsProtected.xlsb
    32.2 KB · Đọc: 19
Upvote 0
Có cách này: bạn hiện thông báo "nếu muốn cập nhật thành công vui lòng bật UAC về mức MIN rồi bấm cập nhật". :)
Hoặc chạy bằng CMD với quyền Administrator: ShellExecute
Làm vậy cũng được, nhưng phần lớn người dùng sẽ không biết đưa UAC về mức thấp nhất (Có thể viết hướng dẫn nhưng cách này sẽ không được chuyên nghiệp lắm). Vì vậy viết được code làm luôn điều này nửa mới ngon, tức là trước khi Update mình đưa nó về mức thất nhất, sau đó Update, khi update xong trả nó về hiện trạng ban đầu (dùng luôn code VBA) nhưng hiện tại mình tịch cái vụ này. Nên cách giải quyết hiện tại là cho phép người dùng chọn đường dẫn lưu file setup về máy, sau đó cài lại file setup, thấy hơi phiền.
 
Upvote 0
Chương trình sẽ chạy như sau:
Khi mởi file macro1 sẽ mở thêm file data.
sau đó kiểm tra phiên bản. nếu ok thì tắt file data và mở file macro1. ngược lại thì thiện thông báo yêu cầu update.
khi nhấn update thì file macro1 sẽ mở file macro2 và lấy toàn bộ dữ liệu từ macro1 chuyển qua macro2.
cuối cùng là save as macro2 với tên của macro1 + thêm số phiên bản tiếp theo là đóng và xóa macro1.
xong!!!

Tôi xem file của bạn rồi. Code hoành tránh nhỉ.
Tôi hỏi thêm chút cho rõ về qui trình cập nhật nhé.
- File macro1 là file người ta đang sử dụng trên máy người ta. Có thể nhiều người dùng ở nhiều máy khác nhau.
- Khi muốn cập nhật thì bạn phải qua một bước là chủ động yêu cầu người dùng tải 2 file: Member_data.xlsm và TH-BOM-Mau.xlsm về lưu vào cùng đường dẫn file macro1 mà họ đang sử dụng thì mới Update được đúng không? Vì tôi thấy sự kiện On Open bạn dùng ThisWorkbook.Path + ...
Cảm ơn bạn đã chia sẻ một cách cập nhật ứng dụng Excel hay.
 
Upvote 0
Tôi xem file của bạn rồi. Code hoành tránh nhỉ.
Tôi hỏi thêm chút cho rõ về qui trình cập nhật nhé.
- File macro1 là file người ta đang sử dụng trên máy người ta. Có thể nhiều người dùng ở nhiều máy khác nhau.
- Khi muốn cập nhật thì bạn phải qua một bước là chủ động yêu cầu người dùng tải 2 file: Member_data.xlsm và TH-BOM-Mau.xlsm về lưu vào cùng đường dẫn file macro1 mà họ đang sử dụng thì mới Update được đúng không? Vì tôi thấy sự kiện On Open bạn dùng ThisWorkbook.Path + ...
Cảm ơn bạn đã chia sẻ một cách cập nhật ứng dụng Excel hay.
Không bạn ơi.
File mình đưa lên là chỉnh sửa lại đường dẫn rồi. vì không chỉnh sửa thì các bạn không chạy chương trình được.
2 file ( Data với File gốc) bạn sẽ để 1 nơi thôi nhưng phải cố định. Còn file người dùng thì bạn có thể đưa đi đâu cũng được. chương trình không quan tâm.
Nó chỉ quan tâm file gốc có tồn tại ở thư mục chỉ định hay không và file data cũng vậy.
Vì chỉ muốn các bạn hiểu code update chạy thế nào nên mới xóa đi khá khá. chứ thực chất các điều kiện của file gốc nó còn phức tạp hơn nữa.
Bạn muốn chi tiết thì zalo vào số này nhé. có time mình sẽ giúp bạn. 0354 366 282
 
Upvote 0
Xin lỗi nha!.
Quên xóa điều kiện check member.
Gửi lại bạn nhé.
Hay quá
Bài đã được tự động gộp:

Tôi không tải file bạn, nhưng bạn xem file tôi viết có thể áp dụng cho file của mình được hay không? Trong file có tham khảo code ở link sau:
Hay lắm, nhưng có cách nào nó tự click ok luôn hong hén.
 
Upvote 0
:) Thực ra là tôi chưa trải nghiệm cái vụ phân phối ứng dụng bằng Excel và tung ra các bản nâng cấp của nó sau đó.
Vì ứng dụng Excel không có tách được dữ liệu ra riêng và ứng dụng giao diện người dùng riêng nên việc tung các bản cập nhật sẽ gặp khó khăn trong việc chuyển dữ liệu đang sử dụng sang file mới.
Theo tôi nếu bạn thiết kế CSDL kỹ lưỡng, chuẩn hoá, dữ liệu lưu trong các sheet riêng thì có thể dùng cách copy (viết code để đồng bộ) các dữ liệu gốc này sang file mới và chạy thôi. Một chú ý quan trọng là bản nâng cấp không đụng gì tới việc thay đổi cấu trúc, thiết kế bảng dữ liệu (không thêm cột, thay đổi thứ tự cột v.v..).
Một số ý kiến cá nhân là vậy, để các bạn chuyên về ứng dụng trên nền Excel góp ý thêm nhé.
Cách này ổn. Tôi đã dùng kiểu này. Khi thay đổi code, tôi chỉ cần gửi cho người dùng 1 file trống. Người dùng chạy sub chuyển hết dữ liệu từ file cũ sang. Các name (nếu có), format đều code để mang sang hết.
 
Upvote 0
Hay quá
Bài đã được tự động gộp:


Hay lắm, nhưng có cách nào nó tự click ok luôn hong hén.
Mình tạo ra 3 file để điều khiển bởi vì mình phải quản lý thêm nember và phân quyền cho từng người.
Trên thực tế các bạn chỉ cần sử dụng 2 file là có thể auto update.
1 file ng dùng sử dụng như bình thường (coppy ra bao nhiêu file không ảnh hưởng)
1 file gốc bạn để ở ổ Public.

Bản chất 2 file này cũng chỉ là 1 file coppy ra và điểm khác biệt là (khác tên file) và (khác phiên bản code) thôi.
Nếu bạn nghĩ: "Làm sao để update modul nhỉ" thì tại sao mình không nghĩ đơn giản hơn là: "Làm cách nào để update dữ liệu cũ sang file mới"
Cách nào dễ hơn nhỉ :)
 
Upvote 0
Upvote 0
Anh ơi,
nó update nhiều module 1 lần không được hả? nó lại xuất hiện hộp nhập pass phải nhấn ok khi import trên 1 file
Nếu bạn muốn thay nhiều Module thì bạn phải cho nó vào vòng lặp chứ. Ví dụ
Mã:
        For i = 1 To UBound(Arr)
            Set Md = .VBProject.VBComponents.Import(Arr(i))
            Md.Name = Arr_New(i)
        Next i
Trong đó Arr là danh sách đường dẫn các Module, còn Arr_New là danh sách các module.
À quên bạn phải sửa code của vòng lặp phía trên và sửa luôn điều kiện để remove Module nửa, và khi thỏa mãn điều kiện thì không được Exit For mà phải duyệt tiếp tục đến hết vòng lặp.
Mã:
               If UCase(mdlName) = Module_Name Then
                    .VBProject.VBComponents.Remove .VBProject.VBComponents(mdlName)
                    Exit For
                End If
 
Upvote 0
Nếu bạn muốn thay nhiều Module thì bạn phải cho nó vào vòng lặp chứ. Ví dụ
Mã:
        For i = 1 To UBound(Arr)
            Set Md = .VBProject.VBComponents.Import(Arr(i))
            Md.Name = Arr_New(i)
        Next i
Trong đó Arr là danh sách đường dẫn các Module, còn Arr_New là danh sách các module.
À quên bạn phải sửa code của vòng lặp phía trên và sửa luôn điều kiện để remove Module nửa, và khi thỏa mãn điều kiện thì không được Exit For mà phải duyệt tiếp tục đến hết vòng lặp.
Mã:
               If UCase(mdlName) = Module_Name Then
                    .VBProject.VBComponents.Remove .VBProject.VBComponents(mdlName)
                    Exit For
                End If
 
Lần chỉnh sửa cuối:
Upvote 0
Không biết làm sao luôn hic
PHP:
Private Sub InsertModule()
Dim Wb As Workbook, mdlName As String, Md As Object
Dim J As Integer, I As Integer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'Neu lay du lieu tu Sheet thi cho chay dong code duoi day
    Call GetData    'Dong code này se khong can chay neu khai bao hang
    Set Wb = ThisWorkbook
    Call UnlockProject(Wb.VBProject, Pass)  'Test_UnlockProject(Pass)
    With Wb
        For J = .VBProject.VBComponents.Count To 1 Step -1
            If .VBProject.VBComponents(J).Type = 1 Or .VBProject.VBComponents(J).Type = 3 Then '.Type = 0
                    mdlName = .VBProject.VBComponents(J).name '.CodeModule.name
                If UCase(mdlName) = UCase(Module_Name) Then
                    .VBProject.VBComponents.Remove .VBProject.VBComponents(mdlName)
                    Exit For
                End If
            End If
        Next J
'----------------------------------------------------------------
        Set Md = .VBProject.VBComponents.Import(Path_Module_Name)
        Md.name = Module_Name
        .Save
        '.Close True
    End With
    Set Md = Nothing
    Set Wb = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Private Sub GetData()
Dim mArr, I&, J&, eR&
eR = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Update").Range("B:B"))
    mArr = ThisWorkbook.Sheets("Update").Range("A1:E" & eR).Value
    ReDim Arr(1 To UBound(mArr, 1))
    For I = LBound(mArr, 1) To UBound(mArr, 1)
        For J = LBound(mArr, 2) To UBound(mArr, 2)
            Arr(I) = mArr(I, 1)
        Next J
    Next I
    'Path_Module_Name = ThisWorkbook.Path & "\Release\" & Module_Name(I)
   
End Sub
Up cái file bạn đang làm mà chưa được kèm theo các Module bạn cần thay thế lên đây.
 
Upvote 0
Up cái file bạn đang làm mà chưa được kèm theo các Module bạn cần thay thế lên đây.

được rồi anh. hơi lủn củn nhưng chạy đc. Anh xem có hiệu chỉnh chổ nào được không?

PHP:
Private Sub InsertModule()
Dim Wb As Workbook, mdlName As String, Md As Object
Dim sh As Worksheet, nameArr, pathArr
Dim J As Integer, i As Integer, eR As Integer, K As Integer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'Neu lay du lieu tu Sheet thi cho chay dong code duoi day
    'Call GetData    'Dong code này se khong can chay neu khai bao hang
    Set Wb = ThisWorkbook
    Set sh = Wb.Sheets("Update")
    Call UnlockProject(Wb.VBProject, Pass)  'Test_UnlockProject(Pass)
    eR = sh.Range("A100").End(xlUp).Row
    With Wb
        For J = .VBProject.VBComponents.Count To 1 Step -1
            If .VBProject.VBComponents(J).Type = 1 Or .VBProject.VBComponents(J).Type = 3 Then '.Type = 0
                    mdlName = .VBProject.VBComponents(J).name '.CodeModule.name
            For K = 1 To eR
                ReDim Module_Name(K)
                Module_Name(K) = sh.Range("A" & K).Value
                    If UCase(mdlName) = UCase(Module_Name(K)) Then
                        .VBProject.VBComponents.Remove .VBProject.VBComponents(mdlName)
                        'Exit For
                    End If
            Next K
            End If
        Next J
'----------------------------------------------------------------
        For i = 1 To eR
            ReDim pathArr(i)
            ReDim Module_Name(i)
            Module_Name(i) = sh.Range("A" & i).Value
            pathArr(i) = sh.Range("C" & i).Value
            Set Md = .VBProject.VBComponents.Import(pathArr(i))
            Md.name = Module_Name(i)
        Next i
        .Save
        '.Close True
    End With
    Set Md = Nothing
    Set Wb = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom