Solved

VB Script Running Terribly Slow

Posted on 2009-07-01
1
428 Views
Last Modified: 2012-05-07
I am writing a script to go through and migrate all users to a new server in a certain folder on a remote path. The procedure order is this:
1. List the folder to migrate
2. User selects the folder
3. Enumerate the users (folders)  in the folder by outputting a dir command to a text file.
4. Read the text file into a loop then:
        a. Unshare the folder
        b. xcopy their data (without the /X permissions copy)
        c. Set the correct permissions with cacls
        d. Then make the changes in AD.
5. Remove the dir.txt file originally made.

Currently, it is running horrifically slow, as I am testing it with some shared folders i made on the server. I think the problem might be with the "delete share" section and getting a list of all the shares since there are about...over 1000 user shares on this server. I'm just get my hands on VB Script so if I'm over complicating something, let me know.

Any suggestions?

Const WINDOW_HANDLE = 0

Const OPTIONS = 0

strServer = "fileserver1"

strLett = "D$"

 

'Prompt user to select a folder to migrate

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.Namespace("\\" & strServer & "\" & strLett)

Set objFolderItem = objFolder.Self

strPath = objFolderItem.Path

 

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.BrowseForFolder _

	(WINDOW_HANDLE, "Select a folder to migrate to NewStorageServer:", OPTIONS, strPath) 

      

If objFolder Is Nothing Then

    Wscript.Quit

End If

 

Set objFolderItem = objFolder.Self

objPath = objFolderItem.Path

 

'Get the last folder in Path

arrServ = Split(objPath, "\")

strIdx = UBound(arrServ)

strFold = arrServ(strIdx)

 

strContin = InputBox("This will unshare and migrate all users in the " & strFold & " folder to \\NewStorageServer\Students\ directory. Enter Yes to continue otherwise press enter to quit.", "Continue with migration?")

If strContin = "Yes" then

 

'Create the folder list to migrate

Set WshShell = WScript.CreateObject("WScript.Shell")

WshShell.Run "cmd /c dir " & objPath & " /b > c:\dir.txt",, True

WshShell.Run "cmd /c c:"

strFilename = "C:\dir.txt"

 

Dim arrFileLines()

i = 0

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile("" & strFilename & "", 1)

Do Until objFile.AtEndOfStream

	ReDim Preserve arrFileLines(i)

	arrFileLines(i) = objFile.ReadLine

	strUsrShare = arrFileLines(i) & "$"

	strSrcPath = objPath & "\" & arrFileLines(i)

    strDestinationPath = "\\NewStorageServer\Students\" & arrFileLines(i)

    

    'Delete the share

    Set objWMIService = GetObject("winmgmts:" _

    	& "{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")

	Set colShares = objWMIService.ExecQuery _

    	("Select * from Win32_Share Where Name = '" & strUsrShare & "'")

	For Each objShare in colShares

    	objShare.Delete

	Next

 

    'Copy the data and set the permissions

    WshShell.Run "xcopy """ & strSrcPath & """ " & strDestinationPath & " /E /I /V /H /Y",, True

    WshShell.Run "cacls " & strDestinationPath & " /T /E /G domain\" & arrFileLines(i) & ":C ""domain\Domain Admins"":F",, True

	'WshShell.Run "cacls " & strDestinationPath & " /T /E /R Everyone",, true

    WScript.Echo arrFileLines(i) & " has been copied."

 

    i = i + 1

 

Loop

 

WshShell.Run "cmd /c del c:\dir.txt"

WScript.Echo objPath & " has been migrated."

 

Else

WScript.Quit

End If

Open in new window

0
Comment
Question by:b4sherx
1 Comment
 
LVL 38

Accepted Solution

by:
PaulHews earned 500 total points
Comment Utility
It may just be a slow process, especially if there's a lot of files to xcopy.  But you can enumerate the folders with the filesystemobject and you really don't need an array to store the folder names in because you don't need to save them anywhere.
Const WINDOW_HANDLE = 0

Const OPTIONS = 0

strServer = "fileserver1"

strLett = "D$"

 

'Prompt user to select a folder to migrate

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.Namespace("\\" & strServer & "\" & strLett)

Set objFolderItem = objFolder.Self

strPath = objFolderItem.Path

 

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.BrowseForFolder _

        (WINDOW_HANDLE, "Select a folder to migrate to NewStorageServer:", OPTIONS, strPath) 

      

If objFolder Is Nothing Then

    Wscript.Quit

End If

 

Set objFolderItem = objFolder.Self

objPath = objFolderItem.Path

 

'Get the last folder in Path

arrServ = Split(objPath, "\")

strIdx = UBound(arrServ)

strFold = arrServ(strIdx)

 

strContin = InputBox("This will unshare and migrate all users in the " & strFold & " folder to \\NewStorageServer\Students\ directory. Enter Yes to continue otherwise press enter to quit.", "Continue with migration?")

If strContin = "Yes" then

 

    'Create the folder list to migrate

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFolder = objFSO.GetFolder(objPath)

    Set colSubfolders = objFolder.Subfolders

    For Each objSubfolder in colSubfolders

        strUsrShare = objSubfolder.Name & "$"

        strSrcPath = objPath & "\" & objSubfolder.Name

        strDestinationPath = "\\NewStorageServer\Students\" & objSubfolder.Name

        'Delete the share

        Set objWMIService = GetObject("winmgmts:" _

            & "{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")

            Set colShares = objWMIService.ExecQuery _

            ("Select * from Win32_Share Where Name = '" & strUsrShare & "'")

        For Each objShare in colShares

            objShare.Delete

        Next

     

        'Copy the data and set the permissions

        WshShell.Run "xcopy """ & strSrcPath & """ " & strDestinationPath & " /E /I /V /H /Y",, True

        WshShell.Run "cacls " & strDestinationPath & " /T /E /G domain\" & arrFileLines(i) & ":C ""domain\Domain Admins"":F",, True

            'WshShell.Run "cacls " & strDestinationPath & " /T /E /R Everyone",, true

        WScript.Echo arrFileLines(i) & " has been copied."

        

    Next

     
 
 

    WScript.Echo objPath & " has been migrated."

 

Else

    WScript.Quit

End If

Open in new window

0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now