下面是用IIS创建网站的源代码，但运时在“NewWeb.Start”处出现错误，得要人手才能启动网站，请问怎样修改才可以自动启动网站。

Question

'Ip                  IP地址
'IIsInstallPath      目录路径
'ServerComment       站点说明
'HostName            主机头
'Port                侦听端口
'Start               是否重启Public Function CreateIISWebServer(Ip, IIsInstallPath, ServerComment, HostName, Port, webStart)
    Dim obj As Object
    Dim Web, NewWeb, Child, VirDir As Object
    Dim SBinds()
    Dim WebName, i
    WebName = 1
    'On Error GoTo lbErr
    Err.Clear
    Set Web = GetObject("IIS://LocalHost/W3SVC")    Do While Err.Number <> 0
        If MsgBox("本服务器的Internet Iformation Server 未启动，请启动后重试。", vbRetryCancel, "IIS服务未启动") = vbCancel Then End
        Err.Clear
        Set Web = GetObject("IIS://LocalHost/W3SVC")
    Loop
    Err.Clear
    For Each Child In Web
        If IsNumeric(Child.Name) Then
            If CInt(Child.Name) >= WebName Then WebName = CInt(Child.Name) + 1
        End If
    Next
    Set NewWeb = Web.Create("IIsWebServer", WebName)
    NewWeb.ServerComment = ServerComment
    NewWeb.KeyType = "IIsWebServer"
    ReDim SBinds(0)
    SBinds(0) = Ip & ":" & Port & ":" & HostName
    NewWeb.ServerBindings = SBinds
    NewWeb.AccessRead = True
    NewWeb.frontPageWeb = True
    NewWeb.EnableDefaultDoc = True
    NewWeb.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.html, Index.asp"
    NewWeb.AccessScript = True
    NewWeb.AccessExecute = True
    Set VirDir = NewWeb.Create("IIsWebVirtualDir", "Root")
    VirDir.Path = IIsInstallPath
    VirDir.AppCreate "TRUE"
    VirDir.SetInfo
    NewWeb.SetInfo
        If webStart = True Then
            Err.Clear
            NewWeb.Start        End If
    GoTo lbExit
    
lbErr:
    iReturn = Error
lbExit:
    CreateIISWebServer = iReturnEnd FunctionPrivate Sub Form_Load()
    ifError = CreateIISWebServer("192.168.0.140", "d:\asp\hag", "www.sit.com", "www.sit.com", "80", True)
    MsgBox ifError
End Sub

Answer 1

没有问题
Public Function WebVirtualDir(ByVal strWebSite As String, ByVal strFriendlyName As String, ByVal strWebPath As String, ByVal strDefaultDoc As String) As Boolean
Dim objADSI As Object
Dim objWebVDir As Object
On Error GoTo Lib_Err
Set objADSI = GetObject("IIS://LocalHost/W3SVC/1/Root")
Set objWebVDir = objADSI.Create("IIsWebVirtualDir", strWebSite)
objWebVDir.SetInfo
Set objWebVDir = objADSI.GetObject("IIsWebVirtualDir", strWebSite)
objWebVDir.AppCreate True
objWebVDir.Put "AppFriendlyName", strFriendlyName
objWebVDir.Put "AppRoot", "/LM/W3SVC/1/Root/" & strWebSite
objWebVDir.Put "Path", strWebPath
objWebVDir.Put "AppIsolated", 0
objWebVDir.Put "DefaultDoc", strDefaultDoc
objWebVDir.Put "AccessFlags", 535
objWebVDir.SetInfo
WebVirtualDir = True
Lib_End:
Set objWebVDir = Nothing
Set objADSI = Nothing
Exit Function
Lib_Err:
WebVirtualDir = False
strError = Err.Description
Err.Clear
Resume Lib_End
End FunctionPrivate Sub Command1_Click()
Call WebVirtualDir("aa", "aa", "E:\Web", "Default.asp")
End Sub