'起用和禁用网络连接

Option Explicit

Private Const NetConnect = &H31

Private Sub Command1_Click() '停用本地连接
    Dim blnRelust As Boolean
    '把 本地连接换成你要控制的本地连接的名字
    blnRelust = ExcNetLinkMenu("本地连接", "停用(&B)")
    'xp
    If blnRelust Then
        Debug.Print "停用成功"
    Else
       blnRelust = ExcNetLinkMenu("本地连接", "禁用(&B)")
    End If
    If blnRelust Then
       Debug.Print "停用成功"
    Else
      Debug.Print "停用失败"
    End If
End Sub

Private Sub command2_Click() '启用本地连接
'把 本地连接换成你要控制的本地连接的名字
    Dim blnRelust As Boolean
    blnRelust = ExcNetLinkMenu("本地连接", "启用(&A)")
    If blnRelust Then
        Debug.Print "启用成功"
    Else
        Debug.Print "启用失败"
    End If
End Sub

'首先引用Microsoft Shell Controls And Automation
'先找到“网络连接”这个虚拟文件夹，然后找到要控制的本地连接对应的folderitem，然后枚举verb，找到需要的verb后，调用verb的DoIt方法

Private Function ExcNetLinkMenu(ByVal AdapterName As String, ByVal MenuName As String) As Boolean
    Dim objShell As New Shell32.Shell
    Dim objFolder As Shell32.Folder
    Dim objFolderItem As Shell32.FolderItem
    Dim objShellFolderItem As ShellFolderItem
    Dim objFolderItemVerb As Shell32.FolderItemVerb
    Dim blnRelust As Boolean
    On Error Resume Next
    Set objFolder = objShell.NameSpace(NetConnect)
    If ObjPtr(objFolder) = 0 Then
        ExcNetLinkMenu = False
        GoTo Exitfunction
    End If
    For Each objFolderItem In objFolder.Items '遍历网络连接文件夹集合
        If objFolderItem.Name = AdapterName Then
            Set objShellFolderItem = objFolderItem
            blnRelust = True
            Exit For
        End If
    Next
    If blnRelust = False Then
        ExcNetLinkMenu = False
        GoTo Exitfunction
    End If
    For Each objFolderItemVerb In objShellFolderItem.Verbs '遍历本地连接的右键菜单
        If objFolderItemVerb.Name = MenuName Then
            objFolderItemVerb.DoIt
            ExcNetLinkMenu = True
            Exit For
        End If
    Next
    If blnRelust = False Then ExcNetLinkMenu = False
Exitfunction:
    Set objShell = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
    Set objShellFolderItem = Nothing
    Set objFolderItemVerb = Nothing
End Function