dcsimg
Results 1 to 3 of 3

Thread: My VB script keeps coming up with a DEBUG message and can I add a message box.

  1. #1

    Thread Starter
    Junior Member
    Join Date
    May 2018
    Posts
    23

    My VB script keeps coming up with a DEBUG message and can I add a message box.

    Hi I had been given the following VB script and I had amended it a bit and I now keep getting a DEBUG message box come up all the time and I have to click "OK" all the time.

    I plea to you and can anyone help on the following please please.

    1) get rid of the message box keep popping up , I know it somewhere around where it say *DEBUG* But I don't know what to get rid of.
    2) If poss get a message box appear and stay up all the time the script running to advise it running
    3) If poss get a message box up at the end to say that "ALL FILES MOVED"

    Any help greatly appreciated.

    Many Thanks


    HTML Code:
    Option Explicit
    
    ' Global variables
    Dim strBaseDir, strDestDir
    Dim objFSO, objFile
    Dim arrFiles(), i
    Dim lngFolderSize, intFolderNumber, strNextDir, intMoveFile
    
    ' Define paths to work with
    strBaseDir = "X:\Downloads\DownLoad"
    strDestDir = "X:\DOWNLOADS\SPLIT"
    
    ' Set maximum size of new folders
    Const cMaxFolderSize = 500000000
    
    ' Define class that will hold file information
    Class File
        Public lngSize
        Public strPath
    End Class 
    
    ' Create file system object
    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
    
    ' Fully resolve paths
    strBaseDir = objFSO.GetAbsolutePathname(strBaseDir)
    strDestDir = objFSO.GetAbsolutePathname(strDestDir)
    
    If Not objFSO.FolderExists(strDestDir) Then
        WScript.Echo "*ERROR* Folder does not exist: """ & strDestDir & """."
        WScript.Quit
     End If
     
    ' Initialize array index variable
    i = -1
    
    ' Load info for each file into array (using File class)
    For Each objFile In objFSO.GetFolder(strBaseDir).Files
        ' Don't include any files with size greater than max allowed in a folder
        If objFile.Size > cMaxFolderSize Then
            WScript.Echo "*WARNING* Skipping file: """ & objFile.Path & """, size:""" & objFile.Size & """ exceeds maximum folder size:""" & cMaxFolderSize & """."
        Else
            ' Add another element to the array of type File class
            i = i + 1
            ReDim Preserve arrFiles(i)
            Set arrFiles(i) = New File
    
            ' Store the size and full path to the file
            arrFiles(i).strPath = objFile.Path
            arrFiles(i).lngSize = objFile.Size
        End If
    Next
    
    ' If no files found then exit
    If i = -1 Then
        WScript.Echo "*WARNING* No files found to process."
        WScript.Quit
    End If
    
    ' Sort the files arrary by size in descending order
    SortArray arrFiles
    
    ' Process all files moving to new subfolders until done
    intFolderNumber = 0
    Do
        ' Start a new destination folder and create it (MUST NOT ALREADY EXIST)
        lngFolderSize = cMaxFolderSize
        intFolderNumber = intFolderNumber + 1
        strNextDir = strDestDir & "\" & intFolderNumber & "\"
        objFSO.CreateFolder strNextDir
    
        ' Move files to dest folder until full
        Do
            ' Look for the largest file left that will fit in remaining space
            intMoveFile = GetFileToMove(arrFiles, lngFolderSize)
    
            ' If we found another file to move then move it
            If intMoveFile <> -1 Then
                Wscript.Echo "*DEBUG* Dest:[" & intFolderNumber & "], Available:[" & lngFolderSize & "], File:[" & arrFiles(intMoveFile).strPath & "], Size:[" & arrFiles(intMoveFile).lngSize & "]."
                objFSO.MoveFile arrFiles(intMoveFile).strPath, strNextDir
                lngFolderSize = lngFolderSize - arrFiles(intMoveFile).lngSize
                arrFiles(intMoveFile).lngSize = -1
            End If
        Loop Until intMoveFile = -1
    
    Loop Until AllFilesMoved(arrFiles)
    
    Function GetFileToMove(ByRef arrArray(), lngSize)
        ' Find next largest file to move that fits, -1 if none found
        Dim i
        GetFileToMove = -1
        For i = LBound(arrArray) To UBound(arrArray)
            If arrArray(i).lngSize <> -1 Then
                If arrArray(i).lngSize <= lngSize Then
                    GetFileToMove = i
                End If
                Exit Function
            End If
        Next
    End Function
    
    Function AllFilesMoved(ByRef arrArray())
        ' See if all files have been moved
        Dim i
        AllFilesMoved = True
        For i = LBound(arrArray) To UBound(arrArray)
            If arrArray(i).lngSize <> -1 Then
                AllFilesMoved = False
                Exit Function
            End If
        Next
    End Function
    
    Sub SortArray(ByRef arrArray())
        ' Sort array of files by size, descending order (simple bubble sort)
        Dim i, j, intTemp
        For i = LBound(arrArray) to UBound(arrArray)
            For j = LBound(arrArray) to UBound(arrArray) - 1
    '            If arrArray(j).lngSize < arrArray(j + 1).lngSize Then
                If LCase(arrArray(j).strPath) > LCase(arrArray(j + 1).strPath) Then
                    Set intTemp = arrArray(j + 1)
                    Set arrArray(j + 1) = arrArray(j)
                    Set arrArray(j) = intTemp
                    Set intTemp = Nothing
                End If
            Next
        Next
    End Sub
    

  2. #2
    Hyperactive Member
    Join Date
    Nov 2017
    Posts
    463

    Re: My VB script keeps coming up with a DEBUG message and can I add a message box.

    You asked this in a different thread, were given a solution, fixed it, and then reported back that you didn't save the change and forgot how you fixed it, that despite the fact that every reply to you in that thread was still there for you to look back on.

    Because of that I've been hesitant to assist you with your threads since:

    1) You are dealing with scripts that are moving files around and
    2) Based on your posts, you seem to have little to no scripting experience, and mucking up a script that moves files around without having a good grasp on what you are doing can have very unintended consequences


    That being said, for question 1, all you need to do is add a single quote in front of the below line of code. This tells the vbscript interpreter to treat that line as if it weren't there.

    Code:
           ' Wscript.Echo "*DEBUG* Dest:[" & intFolderNumber & "], Available:[" & lngFolderSize & "], File:[" & arrFiles(intMoveFile).strPath & "], Size:[" & arrFiles(intMoveFile).lngSize & "]."
    For question 2, I have no answer, since in my experience, if you display a message from a script the script execution pauses until that message is acknowledged.

    For question 3, add this line of code in between the two included lines of code already present that you posted:

    Code:
    Loop Until AllFilesMoved(arrFiles)
    
    WScript.Echo "ALL FILES MOVED"
    
    Function GetFileToMove(ByRef arrArray(), lngSize)
    Good luck.

  3. #3

    Thread Starter
    Junior Member
    Join Date
    May 2018
    Posts
    23

    Re: My VB script keeps coming up with a DEBUG message and can I add a message box.

    My apologies and a big thanks you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width