Cài Đặt IP Máy Tính Bằng Code

[Kiều Mạnh]

Mình đang Tìm cách cài đặt IP Máy tính bằng code chạy từ Excel mà chưa Nghỉ ra được .... Tìm trên GPE hoài mà chưa thấy ..... vậy mình muốn hỏi có cách nào Cài đặt IP máy tính theo Hình sau Bằng Code
Bạn nào biết xin chỉ dùm

 

[ndu96081631]

Máy Em cũng vậy chạy thành công Run As ....
Em muốn hỏi có cách nào ta viết code kiểm tra được nếu là "Wi-Fi" thì Set nwName="Wi-Fi" khác thì là Set nwName="Local Area Connection"
Không Anh .............ý Em muốn hỏi viết thành hàm Bao quát nhất xài cho 2 trường hợp đó

Cảm ơn Anh

Thử với hàm này xem:

Function GetWirlessName()
Dim strKeyPath
Dim strComputer
Dim objReg
Dim arrSubKeys
Dim SubKey
Dim strValueName
Dim dwValue
Dim strValue
Const HKLM = &H80000002
strKeyPath = "SYSTEM\CurrentControlSet\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}"
strComputer = "."
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
objReg.Enumkey HKLM, strKeyPath, arrSubKeys
For Each SubKey In arrSubKeys
    strValueName = "MediaSubType"
    objReg.GetDWORDValue HKLM, strKeyPath & "\" & SubKey & "\" & "Connection", strValueName, dwValue
    If dwValue = 2 Then
        strValueName = "Name"
        objReg.GetStringValue HKLM, strKeyPath & "\" & SubKey & "\" & "Connection", strValueName, strValue
        Exit For
    End If
Next
GetWirlessName = strValue
End Function

Mọi thông số được lấy từ Registry.
Tôi không có điều kiện test trên nhiều máy (kết nối không dây và có dây) nên không chắc lắm

 

[Kiều Mạnh]

Thử với hàm này xem:

Function GetWirlessName()
Dim strKeyPath
Dim strComputer
Dim objReg
Dim arrSubKeys
Dim SubKey
Dim strValueName
Dim dwValue
Dim strValue
Const HKLM = &H80000002
strKeyPath = "SYSTEM\CurrentControlSet\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}"
strComputer = "."
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
objReg.Enumkey HKLM, strKeyPath, arrSubKeys
For Each SubKey In arrSubKeys
    strValueName = "MediaSubType"
    objReg.GetDWORDValue HKLM, strKeyPath & "\" & SubKey & "\" & "Connection", strValueName, dwValue
    If dwValue = 2 Then
        strValueName = "Name"
        objReg.GetStringValue HKLM, strKeyPath & "\" & SubKey & "\" & "Connection", strValueName, strValue
        Exit For
    End If
Next
GetWirlessName = strValue
End Function

Mọi thông số được lấy từ Registry.
Tôi không có điều kiện test trên nhiều máy (kết nối không dây và có dây) nên không chắc lắm

Máy Em nó báo Empty

 

[ndu96081631]

Chạy lỗi .......... Link sau có các Lệnh liên quan hay Tuy nhiên coi khúc biết khúc ko
https://ss64.com/nt/netsh.html

Trong cái đống đó chắc bạn cần lệnh này: netsh int show interface

 

[ndu96081631]

Máy Em nó báo Empty

Vậy thì bạn kiểm tra lại đường dẫn trong registry trên máy bạn, chỗ nào có "Local Area Connection" thì sửa lại cho phù hợp

 

[befaint]

Nó thiếu theo Hình màu vàng

Chỗ màu vàng theo link anh gửi (https://ss64.com/nt/netsh.html) có đó:

netsh interface ipv4 add dns "Wi-fi" 8.8.8.8  'Connection Name = "Wi-Fi"
netsh interface ipv4 add dns "Wi-fi" 8.8.4.4 index=2

 

[ndu96081631]

Mạnh thử test code này xem thế nào

Sub Test()
  Const NW_CONNECTION = &H31&
  Dim objShell As Object, item, objConn As Object
  Set objShell = CreateObject("Shell.Application")
  Set objConn = objShell.Namespace(NW_CONNECTION)
  For Each item In objConn.Items
    MsgBox item.Name
  Next
End Sub

Không chắc nên phải test trên nhiều máy, nhiều kiểu kết nối để rút ra kết luận

 

[Kiều Mạnh]

Vậy thì bạn kiểm tra lại đường dẫn trong registry trên máy bạn, chỗ nào có "Local Area Connection" thì sửa lại cho phù hợp

Em Ctrl + F Local Area Connection thì nó cho ra như hình
khóa Sau
Computer\HKEY_LOCAL_MACHINE\SYSTEM\Setup\Upgrade\NetworkDriverBackup\Control\Network\{4d36e972-e325-11ce-bfc1-08002be10318}\{B8EFE705-08BC-465B-9979-E29EF62D1A12}\Connection

 

[Kiều Mạnh]

Mạnh thử test code này xem thế nào

Sub Test()
  Const NW_CONNECTION = &H31&
  Dim objShell As Object, item, objConn As Object
  Set objShell = CreateObject("Shell.Application")
  Set objConn = objShell.Namespace(NW_CONNECTION)
  For Each item In objConn.Items
    MsgBox item.Name
  Next
End Sub

Không chắc nên phải test trên nhiều máy, nhiều kiểu kết nối để rút ra kết luận

máy Em Ok ... máy Desktop xài cáp Quang ... code chạy rất nhanh
Chạy Windows10_x32 ... Còn x64 Em ko có nên không Biết
Mới thử Windows7_x32 cũng vậy ... Tốt nhưng nó sẻ báo ở Máy LAN2 là 2 lần Msgbox:
1/ Local Area Connection
2/ Local Area Connection 2

Lần 2 Thêm số 2 cuối

 

[Kiều Mạnh]

Em mới coi trên mạng thấy code này nó chạy cũng rất nhanh

Private Sub Test()
    Dim oWMI, Instances, Instance
    Set oWMI = GetObject("WINMGMTS:\\.\ROOT\cimv2")
    Set Instances = oWMI.InstancesOf("Win32_NetworkAdapter")
    For Each Instance In Instances
        If Instance.NetconnectionID <> "null" Then
            MsgBox (Instance.NetconnectionID & "---" _
            & Instance.AdapterType & "-----" & Instance.NetConnectionStatus)
        End If
    Next
End Sub

 

[Kiều Mạnh]

Anh @kieumanh thử dùng PowerShell xem sao...

Mạnh có Tìm hiểu nhiều về IP thấy trên GPE có code sau chạy tốt .......... Nhưng Mình thấy cách Viết hơi dài rồi Mình có thử nghiên Cứu Winsock Mình viết thành code sau rất Gọn vậy Nhờ Bạn test dùm trên Windows_x64 xem 2 code sau nó như thế nào với
1/ Code Copy trên GPE

Private Sub GetIPAddress()
    Dim Item
    Dim rIP As String
    On Error Resume Next
    With GetObject("winmgmts:\\.\root\cimv2")
      For Each Item In .ExecQuery("Select * from Win32_NetworkAdapterConfiguration", , 48)
        Range("A65536").End(xlUp).Offset(1) = Item.IPAddress(0)
        'MsgBox (Item.IPAddress(0))
      Next
    End With
End Sub

2/ Code Mạnh Nghiên cứu Winsock để Viết

Public Function GetIPAddress()
    GetIPAddress = CreateObject("MSWinsock.Winsock").LocalIp
    'MsgBox GetIPAddress
    Range("A65536").End(xlUp).Offset(1) = GetIPAddress
End Function

Xin cảm Ơn

 

[befaint]

test dùm trên Windows_x64

Code 1 thì ngon lành.
Code 2 không chạy:

 

[Kiều Mạnh]

Code 1 thì ngon lành.
Code 2 không chạy:
View attachment 180428

vậy là x64 .......... Winsock nó tịt rồi

 

[befaint]

vậy là x64 .......... Winsock nó tịt rồi

Thử tìm trong /Windows nhưng không thấy file MSWINSCK.OCX

Anh Mạnh thử cái này xem.
http://www.keysight.com/main/editor...0001131:epsg:sud&nid=-11143.0.00&lc=eng&cc=VN

 

[Kiều Mạnh]

Thử tìm trong /Windows nhưng không thấy file MSWINSCK.OCX

Anh Mạnh thử cái này xem.
http://www.keysight.com/main/editor...0001131:epsg:sud&nid=-11143.0.00&lc=eng&cc=VN

sao hay vậy ...Mạnh xem tối qua rồi ...........Lỗi ...........ko biết tại sao đang để đó chưa coi lại