如何复制其它项目的收藏夹到本项目中

---转载之hp的官方论坛

'Script for copying a public favorite to all other projects
'Jan Czajkowski, jan.czajkowski@sqs-nordic.com, Aug. 25 2009

Function getCommonSetting(aTdc, category, settingName)
    Set cs = aTdc.CommonSettings
    cs.Open category
    getCommonSetting = cs.Value(settingName)
    cs.Close
    Set cs = Nothing
End Function


Sub setCommonSetting(aTdc, category, settingName, value)
    Set cs = aTdc.CommonSettings
    cs.Open category
    cs.Value(settingName) = value
    cs.Close
    Set cs = Nothing
End Sub


Sub copyFavorite (category, favoriteName)
    'Get the contents of the favorite you want to copy
    tdc.Connect sourceDomain, sourceProject
    templateSettingValue = getCommonSetting(tdc, category, favoriteName)
    tdc.Disconnect
    Set domainList = tdc.VisibleDomains
    For Each dom in domainList
        For Each proj In tdc.VisibleProjects(dom)
            If proj <> sourceProject Then
                tdc.Connect dom, proj
                setCommonSetting tdc, category, favoriteName, templateSettingValue
                f.WriteLine proj & ": Copied common setting " & favoriteName
                tdc.Disconnect
            End If
        Next
    Next
    Set domainList = Nothing
End Sub


'Log your progress to a file
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("c:/LoggingFavorites.txt", 2, True)


password = InputBox("Password:")
user = InputBox("User name:")
server = "http://YourQCServer:8080/qcbin"
sourceDomain = "YourDomain"
sourceProject = "YourProject"

Set tdc = CreateObject("tdapiole80.tdconnection")
tdc.InitConnectionEx (server)
tdc.Login user, password

copyFavorite "Category", "A public favorite"
copyFavorite "AnotherCategory", "Another public favorite"

tdc.ReleaseConnection
f.Close
msgbox "Finished copying favorites"