Private Sub Command1_Click()
Dim ret As String
ret = SetStaticIp("192.168.0.2", "255.255.255.0", "192.168.0.1")
Debug.Print ret
End Sub
Public Function SetStaticIp(ByVal pIPAddress As String, _
ByVal pSubnet As String, _
ByVal pGateway As String, _
Optional ByVal pDNS1 As String, _
Optional ByVal pDNS2 As String) _
As String
Dim objWMIService As Object
Dim colNetAdapters As Object
Dim objNetAdapter As Object
Dim strSelect As String
Dim strIPAddress As String
Dim strSubnet As String
Dim strGateway As String
Dim strDns1 As String
Dim strDns2 As String
Dim varIPAddress As Variant
Dim varSubnet As Variant
Dim varGateway As Variant
Dim varGatewaymetric As Variant
Dim varDns As Variant
Dim lngEnable As Long
Dim lngGateways As Long
Dim lngDns As Long
Dim blnDns As Boolean
On Error GoTo Error_Handler
blnDns = True
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
strSelect = "Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE"
Set colNetAdapters = objWMIService.ExecQuery(strSelect)
strIPAddress = Trim$(pIPAddress)
strSubnet = Trim$(pSubnet)
strGateway = Trim$(pGateway)
If Not IsMissing(pDNS1) Then
strDns1 = Trim$(pDNS1)
End If
If Not IsMissing(pDNS2) Then
strDns2 = Trim$(pDNS2)
End If
varIPAddress = Array("" & strIPAddress & "")
varSubnet = Array("" & strSubnet & "")
varGateway = Array("" & strGateway & "")
varGatewaymetric = Array(1)
If Len(strDns1) = 0 Then
If Len(strDns2) = 0 Then
blnDns = False
varDns = ""
Else
varDns = Array("" & strDns2 & "")
End If
Else
If Len(strDns2) = 0 Then
varDns = Array("" & strDns1 & "")
Else
varDns = Array("" & strDns1 & "", "" & strDns2 & "")
End If
End If
For Each objNetAdapter In colNetAdapters
lngEnable = objNetAdapter.EnableStatic(varIPAddress, varSubnet)
lngGateways = objNetAdapter.SetGateways(varGateway, varGatewaymetric)
If blnDns = True Then
lngDns = objNetAdapter.SetDNSServerSearchOrder(varDns)
Else
lngDns = objNetAdapter.SetDNSServerSearchOrder()
End If
Next
If lngEnable > 1 Then
SetStaticIp = NetworkResults(lngEnable)
ElseIf lngGateways > 1 Then
SetStaticIp = NetworkResults(lngGateways)
ElseIf lngDns > 1 Then
If lngDns = 70 Then
SetStaticIp = "Invalid DNS Address"
Else
SetStaticIp = NetworkResults(lngDns)
End If
Else
SetStaticIp = NetworkResults(lngEnable)
End If
Error_Handler:
Set colNetAdapters = Nothing
Set objWMIService = Nothing
Set objNetAdapter = Nothing
If Err <> 0 Then _
SetStaticIp = "Error. " & Err.Description
End Function
Public Function NetworkResults(ByVal pNumber As Integer)
Dim sResults As String
Select Case pNumber
Case 0: sResults = "Success, No Reboot Required"
Case 1: sResults = "Success, Reboot Required"
Case 64: sResults = "Method Not Supported"
Case 65: sResults = "Unknown Failure"
Case 66: sResults = "Invalid Subnet Mask"
Case 67: sResults = "Processing Error"
Case 68: sResults = "Invalid Input"
Case 69: sResults = "Gateways Limit Error"
Case 70: sResults = "Invalid IP address"
Case 71: sResults = "Invalid Gateway Address"
Case 72: sResults = "Registry Access Error"
Case 73: sResults = "Invalid Domain Name"
Case 74: sResults = "Invalid Host Name"
Case 75: sResults = "No WINS Server Defined"
Case 76: sResults = "Invalid File"
Case 77: sResults = "Invalid System Path"
Case 78: sResults = "File Copy Failed"
Case 79: sResults = "Invalid Security Parameter"
Case 80: sResults = "Unable to Configure TCP/IP"
Case 81: sResults = "Unable to Configure DHCP"
Case 82: sResults = "Unable to Renew DHCP"
Case 83: sResults = "Unable to Release DHCP"
Case 84: sResults = "IP Not Enabled On Adapter"
Case 85: sResults = "IPX Not Enabled On Adapter"
Case 86: sResults = "Frame/Network Error"
Case 87: sResults = "Invalid Frame Type"
Case 88: sResults = "Invalid Network Number"
Case 89: sResults = "Duplicate Network Number"
Case 90: sResults = "Parameter Out Of Bounds"
Case 91: sResults = "Access Denied"
Case 92: sResults = "Out Of Memory"
Case 93: sResults = "Already Exists"
Case 94: sResults = "Path, File, or Object Not Found"
Case 95: sResults = "Unable To Notify Service"
Case 96: sResults = "Unable To Notify DNS Service"
Case 97: sResults = "Interface Not Configurable"
Case 98: sResults = "Not All DHCP Released/Renewed"
Case 100: sResults = "DHCP Not Enabled On Adapter"
End Select
NetworkResults = sResults
End Function
