Public Function AddPortMapping(port As Long, toIP As String, ForwardName As _
  String, Optional Protocol As String = "TCP") As Boolean
 
On Error GoTo err1
 
Dim mappingPorts
Dim theNatter
 
Set theNatter = CreateObject("HNetCfg.NATUPnP")
Set mappingPorts = theNatter.StaticPortMappingCollection
 
mappingPorts.Add port, Protocol, port, toIP, True, ForwardName
 
AddPortMapping = True
Exit Function
 
err1:
AddPortMapping = False
 
End Function

Public Function GetInformation() As String
Dim tempstr As String
Dim mappingPorts
Dim theNatter
Dim mappingport
tempstr = ""
 
On Error GoTo err1
Set theNatter = CreateObject("HNetCfg.NATUPnP")
Set mappingPorts = theNatter.StaticPortMappingCollection
 
For Each mappingport In mappingPorts
    tempstr = tempstr & mappingport.Description & ", " & _
      mappingport.ExternalPort & ", " & mappingport.Protocol & ", " & _
      mappingport.InternalPort & ", " & mappingport.InternalClient & vbCrLf
Next
 
 
GetInformation = tempstr
Exit Function
 
err1:
GetInformation = "Error!"
End Function

Public Function GetMappingCount() As Integer
On Error GoTo err1
 
Dim mappingPorts
Dim theNatter
 
Set theNatter = CreateObject("HNetCfg.NATUPnP")
Set mappingPorts = theNatter.StaticPortMappingCollection
 
GetMappingCount = mappingPorts.Count
Exit Function
 
err1:
 
End Function

Msgbpx AddPortMapping(LastPortUsed, wsckServer(0).LocalIP, "Test")
MsgBox  GetMappingCount & " mappings."
MsgBox  GetInformation

LG,Robert