Giúp em code chỉ cho phép mở file tại máy tính của công ty

[nhnn1986]

Chào Anh/Chị ạ, em có vấn đề này cần giúp đỡ
Công ty em có domain là snow.com, mỗi nhân viên có 1 user để log vào máy tính tại cơ quan với User là tên email và là tên của nhân viên đó, ví dụ nhân viên: vinhhung.dam (em kèm hình để dễ hình dung)

Công ty có file excel chỉ cho 10 user trong range(A1:A10) được mở file như code ở phía dưới => User "vinhhung.dam" nằm trong range (A1:A10) thì sẽ mở được file.
Ví dụ code phía dưới chỉ mở được User: snow\vinhhung.dam

Nay em nhờ anh chị giúp đoạn code để tất cả User trong công ty đều mở được với điều kiện cùng domain snow.com
Tức là tất cả các máy tính có domain snow\userabc đều mở được file (userabc là user bất kỳ trong công ty)

Xin cảm ơn ạ./.

Private Sub Workbook_Open()
Dim UserNames As Variant
With Me.Sheets("Username")
UserNames = .Range("A1:A10").Value
End With
If Not IsNumeric(Application.Match(Environ("UserName"), UserNames, 0)) Then
    MsgBox "Xin chao " & Environ("UserName") & "file se dong"
   Me.Close False
Else
    MsgBox "Xin chao " & Environ("UserName") & "Ban da mo duoc file"
End If
End Sub

 

[LamNA]

Chào Anh/Chị ạ, em có vấn đề này cần giúp đỡ
Công ty em có domain là snow.com, mỗi nhân viên có 1 user để log vào máy tính tại cơ quan với User là tên email và là tên của nhân viên đó, ví dụ nhân viên: vinhhung.dam (em kèm hình để dễ hình dung)

Công ty có file excel chỉ cho 10 user trong range(A1:A10) được mở file như code ở phía dưới => User "vinhhung.dam" nằm trong range (A1:A10) thì sẽ mở được file.
Ví dụ code phía dưới chỉ mở được User: snow\vinhhung.dam

Nay em nhờ anh chị giúp đoạn code để tất cả User trong công ty đều mở được với điều kiện cùng domain snow.com
Tức là tất cả các máy tính có domain snow\userabc đều mở được file (userabc là user bất kỳ trong công ty)

Xin cảm ơn ạ./.

Private Sub Workbook_Open()
Dim UserNames As Variant
With Me.Sheets("Username")
UserNames = .Range("A1:A10").Value
End With
If Not IsNumeric(Application.Match(Environ("UserName"), UserNames, 0)) Then
    MsgBox "Xin chao " & Environ("UserName") & "file se dong"
   Me.Close False
Else
    MsgBox "Xin chao " & Environ("UserName") & "Ban da mo duoc file"
End If
End Sub

View attachment 213876

Bạn thay thử trong vùng A1:A10 một name có tên snow\ xem được không?
Ủa mà hình như cái này chỉ lấy tên user máy tinh thôi đâu lấy địa chỉ domain thì phải.
Máy tính nào trùng tên trong đó là sẽ mở được, không nhất thiết phải trong domain

 

[ongke0711]

Thêm dấu nháy đơn trước dòng Me.Close

 

[nhnn1986]

Bạn thay thử trong vùng A1:A10 một name có tên snow\ xem được không?
Ủa mà hình như cái này chỉ lấy tên user máy tinh thôi đâu lấy địa chỉ domain thì phải.
Máy tính nào trùng tên trong đó là sẽ mở được, không nhất thiết phải trong domain

Đúng như anh nói đó, code em chỉ lấy username máy tính nằm trong range(A1:A10) nên giờ em muốn code lấy cái domain "snow\" để bất cứ ai trong công ty log in cũng mở được ấy ạ

 

[ongke0711]

Thêm dấu nháy đơn trước dòng Me.Close

Lúc nãy đọc không kỹ tưởng bạn muốn phá code để mọi người vô.

Về các domain thì trong code bạn đã dùng hàm environ rồi thì dùng nó luôn để xác định domain.

strUserDomain = Environ$("UserDomain")
If strUserDomain và Username trong range gì đó thì
    --> cho vô
end if

hoặc tốt hơn là dùng Windows script: theo người ta nói nó an toàn hơn dùng Environ() vì hàm Environ() có thể bị SQL injection. Nhưng bạn dùng Excel thì không ảnh hưởng gì

Function getDomain() As String
    Dim oNetWork As Object
    Set oNetwork = CreateObject("WScript.Network")
    getDomain=oNetwork.UserDomain
   Set oNetwork = Nothing
End function

 

[nhnn1986]

Để mai lên cơ quan em thử code đã ạ, cảm ơn Anh/Chị trước hi hi

 

[LamNA]

Đúng như anh nói đó, code em chỉ lấy username máy tính nằm trong range(A1:A10) nên giờ em muốn code lấy cái domain "snow\" để bất cứ ai trong công ty log in cũng mở được ấy ạ

Thử như vậy chỉnh lại tên Domain hiển thị ở thông báo

Private Sub Workbook_Open()
Dim UserNames As Variant
Dim getDomain As String
Dim oNetWork As Object
Set oNetWork = CreateObject("WScript.Network")
    getDomain = oNetWork.UserDomain
Set oNetWork = Nothing
With Me.Sheets("Home").Select
    UserNames = "DESKTOP-7A3PPVE" 'Chinh lai Domain
End With
If Not getDomain = UserNames Then
    MsgBox "Xin chao " & getDomain & " file se dong"
  ' Me.Close False
Else
    MsgBox "Xin chao " & getDomain & " Ban da mo duoc file"
End If
End Sub

 

[nhnn1986]

Thanks Anh @LamNA , mai em thử ở máy công ty ạ./.

 

[nhnn1986]

Thanks @LamNA với @ongke0711 nhiều ạ, code lấy được domain rồi mà em có thắc mắc nho nhỏ. Domain công ty em là "snow.com" mà sao nó chỉ lấy mỗi "snow" mà không lấy luôn phần đuôi ".com" ạ?

 

[LamNA]

Cảm ơn @LamNA với @ongke0711 nhiều ạ, code lấy được domain rồi mà em có thắc mắc nho nhỏ. Domain công ty em là "snow.com" mà sao nó chỉ lấy mỗi "snow" mà không lấy luôn phần đuôi ".com" ạ?

Cái này là lấy UserDomain thôi nhé, không phải là Domain

 

[nhnn1986]

Cái này là lấy UserDomain thôi nhé, không phải là Domain

Vậy có code nào lấy domain không ạ hi hi

 

[LamNA]

Vậy có code nào lấy domain không ạ hi hi

Mục đích để lấy Domain để làm gì bạn? Vì thực tế lấy tên UserDomain thì file chỉ chạy trong Domain của bạn rồi

 

[nhnn1986]

Mục đích để lấy Domain để làm gì bạn? Vì thực tế lấy tên UserDomain thì file chỉ chạy trong Domain của bạn rồi

Vâng, em chỉ cần code để hạn chế file chỉ mở trong nội bộ công ty thôi, vì vậy nếu Userdomain mà có được chức năng đó thì đủ yêu cầu rồi ạ.

 

[LamNA]

Vâng, em chỉ cần code để hạn chế file chỉ mở trong nội bộ công ty thôi, vì vậy nếu Userdomain mà có được chức năng đó thì đủ yêu cầu rồi ạ.

Thực tế như ở trên là được rồi
Mình gửi thêm bạn tùy biến thêm cho file của bạn : lấy User Domain, lấy User tài khoản , lấy tên máy tính đang mở file

Sub Domain()
Dim Lay As Object
Set Lay = CreateObject("WScript.Network")
MsgBox "Domain & User: " & Lay.Userdomain & "\" & Lay.UserName
MsgBox "Ten PC truy cap: " & Lay.ComputerName & ""
Set Lay = Nothing
End Sub