Dim oComputer
Dim WWWServer, ServerObj, Bindings, Binding, i, DomainArr
oComputer="localhost"
Err.Clear
Set WWWServer = GetObject("IIS://" & oComputer & "/W3SVC")
If Err.Number <> 0 Then
ErrMsg = "无权限操作站点"
' ErrCode = "0x80002"
Exit Function
End If
For Each ServerObj In WWWServer
If ServerObj.Class = "IIsWebServer" Then
Bindings = ServerObj.ServerBindings
For i = 0 To UBound(Bindings)
Binding = Bindings(i)
DomainArr = Split(Binding, ":")
If LCase(DomainArr(2)) = LCase(Domain) Then
GetSiteAdsPath = ServerObj.AdsPath
Exit Function
End If
Next
End If
Next