Vb Script, to copy particular folder with subdirectories from multiple servers to a common location with unique server names as their respective folders

I don't see why this has to be vb script... any particular reason you don't want to use xcopy ?

example ...
xcopy "\\JSBXXX\vphome\*.*" "d:\NewPKI\asia\JSBXXX\vphome\*.*" /D /E /I /R /Y

also, have you considered creating a single batch file to be run as a scheduled task from all servers ?..as opposed to maintaining a script when you have to add and remove servers...

first you set a global environment variable on every server...using this code as a startup script...
This creates a permanent system variable you can use to identify the subnet a server is on, and use it as a variable.
http://www.microsoft.com/technet/scriptcenter/csc/scripts/desktop/settings/cscds060.mspx

example batch script to run on any remote server..

IF %NETID% == 172.16.9 xcopy "\\%computername%\VPhome\*.*" "\\pkiserver\vphome\ASIA\%computername%\NewPKI\*.*" /D /E /I /R /Y
IF %NETID% == 172.16.10 xcopy "\\%computername%\VPhome\*.*" "\\pkiserver\vphome\AMERICA\%computername%\NewPKI\*.*" /D /E /I /R /Y
IF %NETID% == 172.16.11 xcopy "\\%computername%\VPhome\*.*" "\\pkiserver\vphome\MEXICO\%computername%\NewPKI\*.*" /D /E /I /R /Y

let me know what you think...

IF %NETID% == 172.16.9 xcopy "\\%computername%\VPhome\*.*" "\\pkiserver\vphome\ASIA\%computername%\NewPKI\*.*" /D /E /I /R /Y
IF %NETID% == 172.16.10 xcopy "\\%computername%\VPhome\*.*" "\\pkiserver\vphome\AMERICA\%computername%\NewPKI\*.*" /D /E /I /R /Y
IF %NETID% == 172.16.11 xcopy "\\%computername%\VPhome\*.*" "\\pkiserver\vphome\MEXICO\%computername%\NewPKI\*.*" /D /E /I /R /Y

Select allOpen in new window

Option Explicit

Dim strFile, objSh , errorFile, objErr1
Dim  strSrc1, strSrc2, strDest, bolFlag

'Enter the Server name into the Computers.txt file, one entry per line
strFile = "SymantecPSList.txt"

Dim objFSO, objTS, strComputer, objOuts, objFolder, objErr, objFile, i,strLine, objPing, objStatus,colComputer, oComputer
Dim iDR, sName

'specify filename and folder path for file/folder to be copied



strSrc1="\vphome\pki"
strSrc2 = "\vphome\grc.dat"




'specify target destination
strDest="\\mainserver\Final\New Folder\ "



Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSh = CreateObject("WScript.Shell")

'Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("SymantecPSList.txt", ForReading)
Const ForReading = 1
Const ForAppending = 8
 
Dim arrFileLines()
i = 0
Do Until objFile.AtEndOfStream
    Redim Preserve arrFileLines(i)
    arrFileLines(i) = objFile.ReadLine
    i = i + 1
Loop
objFile.Close
 
'     Set objFSO = CreateObject("Scripting.FileSystemObject")
'     Set objSh = CreateObject("WScript.Shell")
    If objFSO.FileExists("output.txt") Then
 
    Else
       Set objFile = objFSO.CreateTextFile("output.txt")
    End If
   
    Set objFile = Nothing
   

''Checks whether Server list is available
If objFSO.FileExists(strFile) Then
   
    Set objFile = objFSO.OpenTextFile("output.txt", ForAppending)
   
    objFile.WriteLine("---------------------------------------------------------------------------------------------")
    objFile.WriteLine("Ping Results of the Servers in the server List as on  " & now())
    objFile.WriteLine("______________________________________________________________________________________________")
    objFile.WriteLine("")
   
' For Each strLine in arrFileLines
'    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
'        ExecQuery("select * from Win32_PingStatus where address = '"_
'            & strLine & "'")
'    For Each objStatus in objPing
'        If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then
'            objFile.WriteLine("Server: " & strLine & " is not reachable" & vbTab & objStatus.ProtocolAddress)
'        Else
'            objFile.WriteLine("Server: " & strLine & " is reachable *********************"& vbTab & objStatus.ProtocolAddress)
'
'For Each strLine in arrFileLines
'WScript.Echo ResolveIP("strLine")
'
'Function ResolveIP(strComputer)
''     On Error Resume Next
'
'    Dim wmiQuery, objWMIService, objPing, objStatus
'    
'    wmiQuery = "Select * From Win32_PingStatus Where " & _
'    "Address = '" & strComputer & "'"
'    
'    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
'    Set objPing = objWMIService.ExecQuery(wmiQuery)
'    
'    For Each objStatus in objPing
'        If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
'            ResolveIP = "Computer is Unreachable!"
'        Else
'            ResolveIP = objStatus.ProtocolAddress
'        End If
'    Next
'End Function
'
'Next
For Each strLine in arrFileLines
If Reachable("strLine") Then
    WScript.Echo "Computer" & strLine & "is Reachable"
Else
    WScript.Echo "Computer is Unreachable!"
End If

Function Reachable(strComputer)
'     On Error Resume Next

    Dim wmiQuery, objWMIService, objPing, objStatus
   
    wmiQuery = "Select * From Win32_PingStatus Where " & _
    "Address = '" & strComputer & "'"
   
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set objPing = objWMIService.ExecQuery(wmiQuery)
   
    For Each objStatus in objPing
        If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
            Reachable = False 'if computer is unreacable, return false
        Else
            Reachable = True 'if computer is reachable, return true
        End If
    Next
End Function


'Set colComputer = GetObject("winmgmts:\\" & strLine & "\root\cimv2").ExecQuery("Select DomainRole, Domain from Win32_ComputerSystem")
'For Each oComputer in colComputer
'iDR = oComputer.DomainRole
'sName = oComputer.Domain
'Next
'
'If iDR = 0 Or iDR = 2 Then
'objFile.WriteLine "Computer is in workgroup " & sName
'Else
'objFile.WriteLine "Computer is in domain " & sName
'End If
 
        End If
    Next
Next
       
End If
' objFile.Close

Set objFile = Nothing

WScript.Echo "****************************************************************************"
WScript.Echo "PKI Folder  Backup in progress, Please wait till the program says 'COMPLETE'"
WScript.Echo "****************************************************************************"
WScript.Echo ""
    Set objTS = objFSO.OpenTextFile(strFile)
    Set objOuts = objFSO.CreateTextFile("PKIbackupServerList.txt")
    Set objErr = objFSO.CreateTextFile("ErrorList.txt")            
   
    objOuts.WriteLine("---------------------------------------------------------------------------------------------")
    objOuts.WriteLine("List of Server Names whose PKI backup was done successfully on  " & now())
    objOuts.WriteLine("______________________________________________________________________________________________")
    objOuts.WriteLine("")
   
    objErr.WriteLine("---------------------------------------------------------------------------------------------")
    objErr.WriteLine("List of Server Names whose PKI backup was not done as on  " & now())
    objErr.WriteLine("______________________________________________________________________________________________")
    objErr.WriteLine("")
   
Do Until objTS.AtEndOfStream
        strComputer = objTS.ReadLine

'Folder created with the respective server names    
'        If objFSO.FolderExists("\\mainserver\Final\New Folder\" & strComputer) Then

Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
        ExecQuery("select * from Win32_PingStatus where address = '"_
            & strComputer & "'")
 For Each objStatus in objPing
    If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then
            objErr.WriteLine("Server: " & strComputer & " is not reachable" & vbTab & objStatus.ProtocolAddress)
    Else
            objOuts.WriteLine("Server: " & strComputer & " is reachable *********************"& vbTab & objStatus.ProtocolAddress)
                     'End If
                     'Next
                    If objFSO.FolderExists("D:\NewPki" & strComputer) Then
           
                            WScript.Echo "Folder " & strComputer & " already exists, Skipping the server"
                            '    objErr.WriteLine("Server: " & strComputer & " is reachable *********************" & vbTab & objStatus.ProtocolAddress)
   
                         'Server list which are skipped.
                             objErr.WriteLine ("Server Name: " & strComputer & " Folder already exists hence skipped PKI backup")
                             objErr.WriteLine("Server: " & strComputer & " is reachable *********************"& vbTab & objStatus.ProtocolAddress)
                             
             
                    Else
               
                        Set objFolder    = objFSO.CreateFolder(strComputer)
                            'PKI folders are copied along with GRC.dat file in the created server folders    
                        '            objSh.Run "Xcopy.exe \\" & strComputer & "\Share\Test " & " " & "\\mainserver\Final\New Folder\" & strComputer & " /e /y"
                        '            objSh.Run "Xcopy.exe \\" & strComputer & "\test2\sam.cab" & " " & "\\mainserver\Final\New Folder\" & strComputer & "  /y"
                                   
'                                    objSh.Run "Xcopy.exe " & strSrc1 & " " & strDest & strComputer & " /e /y"
'                                    objSh.Run "Xcopy.exe " & strSrc2 & " " & strDest & strComputer & "  /y"
                        '            
                        ' '             objSh.Run "Xcopy.exe C:\test C:\Backup /E /Y"
                                   
                                objSh.Run "Xcopy.exe \\" & strComputer & strSrc1 & " " & strDest & "\" & strComputer & " /e /y"
                                objSh.Run "Xcopy.exe \\" & strComputer & strSrc2 & " " & strDest & "\" & strComputer & "  /y"
                        '            objSh.Run "Xcopy.exe \\mainserver\test" & " " &  "\\mainserver\Final\New Folder"  & " /e /y"
                           
                        '         WScript.Echo "Tried the above link for " & strComputer
                        WScript.Echo "Folder Created in the Name of :" & strComputer
                       
                                    objOuts.WriteLine ("PKI Backup done for the Server Name: " & strComputer)
               
                    End If
    End If

Next

Loop


   

'    End If

objTS.Close
 objOuts.Close
 objErr.Close    
 'objFile.Close


WScript.Echo "output of Backup servers will be in PKIbackupServerList.txt file"
WScript.Echo "output of skipped servers will be in ErrorList.txt file"



WScript.Echo
WScript.Echo "Complete :o)"

The above code i fixed and run it in my server, its working. but the query state in the above code "'Set colComputer = GetObject("winmgmts:\\" & strLine & "\root\cimv2").ExecQuery("Select DomainRole, Domain from Win32_ComputerSystem")" throws error while run in windows 2003 environment. hence i commented the Ping status codes.

any idea how to check, whether the server is reachable, if reachable output the IP address and hostname of the server which are done with PKI backup.

P.S. For your question about the schedule backup on servers. The network is huge n the servers are large. any change in the schedule task has to go through proper procedure. this will take a month or two to proceed. I dont want the management to involve in approval / query. thats y i would like to run a vbscript with the list of server names in my network. Moreover, a copy of PKI folder for each server is enough, no need to take the backup again and again as scheduled.

I guess if you have the code working...and you just want to see if a machine is online. Use the code below.  Of course sub strComputer for strHost

http://www.petri.co.il/forums/showthread.php?t=348

'********************************************************************
'* Function IsPingable(strHost)
'*								
'*	Returns True or False based on the output from ping.exe	
'********************************************************************
Function IsPingable(strHost)
	Set objShell = WScript.CreateObject("WScript.Shell")
	Set objExecObject = objShell.Exec("cmd /c ping.exe -n 3 -w 1000 " & strHost)
	Do While Not objExecObject.StdOut.AtEndOfStream
		strText = objExecObject.StdOut.ReadLine()
		If Instr(strText, "Reply") > 0 Then
	        		'Wscript.Echo "Reply received."
	        		IsPingable = True
			Exit Do
		End If
	Loop
	If (IsPingable <> True) Then
		IsPingable = False
	End If
End Function

Select allOpen in new window

here's another..

http://www.tek-tips.com/faqs.cfm?fid=6527