求个获取计算机名字并比对的代码

wzw575

我想在ThisWorkbook加获取本机名字并和预设的名字比对的代码，如果不一致，则弹出窗口“未经允许的拷贝”并关闭，如果一致则弹出窗体正常运行

以下代码在网上找的，但是不管一致不一致都会提示，并且没有一致后正常加载窗体的代码
Private Sub Workbook_Open()
If Application.UserName = "用户名字" Then
For Each ctl In Application.CommandBars.FindControls(ID:=748)
    ctl.Enabled = False
Next
Else
Application.WindowState = xlMinimized
MsgBox "未经允许的拷贝"
Application.Quit
End If
End Sub

请老师指导下

liulang0808

楼主分步执行看看吧

taller

application.UserName返回的是Office的用户名称，不是操作系统的用户名

fxl447098457

environ("computername")

zhenghui13

你可以用Environ来列示相关的用户名，具体可以参考以下网址
http://codevba.com/office/environ.htm#.Xks1BYozZtQ

1. Sub TZ_20200218()
   
2. Dim i As Long
   
3. Dim usID As String
   
4. Dim pcID As String
   
5. Dim strEnviron As String
   
6. 
   
7. usID = Environ("USERNAME")
   
8. pcID = Environ("COMPUTERNAME")
   
9. 
   
10. Debug.Print usID, pcID
    
11. 
    
12. '以下列出所有相关环境变量
    
13. For i = 1 To 255
    
14.     strEnviron = Environ(i)
    
15.     If LenB(strEnviron) = 0& Then Exit For
    
16.     Debug.Print strEnviron
    
17. Next i
    
18. End Sub

复制代码

3190496160

获取硬盘物理系列号对比比较科学一些吧，因为，一台计算机的系列号只要不更换硬盘就是不变的呀

Manrce

光这样不能保密，对方只要不启用宏就行。
你可以设置sheet超级隐藏，确定是对的用户名才能正常显示
然后你要工程保护防止他人修改代码

wzw575

EXCEL用户名和预设的不一样就会弹出提示窗口，并在几秒后自己删除文件
Private Sub Workbook_Open()
If Application.UserName = "sss" Then 'EXCEL用户名
For Each ctl In Application.CommandBars.FindControls(ID:=748)
ctl.Enabled = False
Next
Else
MsgBox "未经允许的拷贝"
Application.OnTime Now + TimeValue("00:00:7"), "killme"
End If
Application.Visible = False
frm_sss.Show '需要加载的窗体
End Sub


我想加上强制启动宏的代码：打开文件如果该机器没有启用宏则所有工作表内容都会被深度隐藏，只有启用宏所有的工作表才会被显示出来，加上以上代码后如果在其他机器上运行会自己删除