Announcement

Collapse
No announcement yet.

Need help adding a progess bar to code

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Need help adding a progess bar to code

    Hi everyone,

    Just to let everyone know that my original account "Shazam" is somehow not working. I'm not able to logon. I sent a private message to the Administrator regarding this issue. In the meanwhile I created another account so I can post a question here. Hopefully I'm not offending anyone.
    Back to my question...

    I have this VBScript below. It will copy a folder from the source location and paste it to any USB flash drives that is connect to your computer simultaneously. This actually works pretty well. The only thing it doesnít have is a progress bar. Is it possible to add to the code?

    Iíve found these 2 links below. That shows how to add a progress bar but I wasnít able to get it to work with the existing code.

    I would like to use the" Windows Shell object" if possible.


    https://technet.microsoft.com/en-us/.../ee176633.aspx

    http://blogs.technet.com/b/heyscript...ing-files.aspx

    Code:
    sFolderToCopy = "C:\Test"
    
    Set oFS = CreateObject("Scripting.FileSystemObject")
    Set dUSBKeys = ScanForUSBKeys()
    
    For Each oUSBKey in dUSBKeys.Keys
       If Left(oUSBKey, 1) = "" Then
         sKey = oUSBKey
       Else
         sKey = oUSBKey & ""
       End If
    
       oFS.CopyFolder sFolderToCopy, sKey
    
    Next
    
    Set dUSBKeys = Nothing
    Set oFS = Nothing
    
    Msgbox "Done."
    
    Function ScanForUSBKeys()
       Set oWMI = GetObject("winmgmts:\\.\root\cimv2")
       Set dTemp = CreateObject("Scripting.Dictionary")
    
       Set cDisks = oWMI.ExecQuery("Select InterfaceType,MediaType,PNPDeviceID,DeviceID,Size from Win32_DiskDrive")
       For Each oDisk in cDisks
         If InStr(LCase(oDisk.InterfaceType),"usb") > 0 AND InStr(LCase(oDisk.MediaType),"removable") > 0 _
             AND InStr(LCase(oDisk.PNPDeviceID),"blackberry") = 0 AND InStr(LCase(oDisk.PNPDeviceID),"ipod") = 0 _
             AND NOT oDisk.PNPDeviceID = "" Then
           Set cDrivePartitions = oWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" & _
             oDisk.DeviceID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition" )
           For Each oDrivePartition in cDrivePartitions
             Set cDriveLetters = oWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" & _
               oDrivePartition.DeviceID & "'} WHERE AssocClass = Win32_LogicalDiskToPartition")
             For Each oDriveLetter in cDriveLetters
               dTemp.Add oDriveLetter.DeviceID, 1
             Next
             Set cDriveLetters = Nothing
           Next
           Set cDrivePartitions = Nothing
         End If
       Next
       Set cDisks = Nothing
       Set ScanForUSBKeys = dTemp
       Set dTemp = Nothing
       Set oWMI = Nothing
    End Function
    Last edited by Rems; 13th May 2015, 20:38.

  • #2
    Have you tried using the Forgot Password or Username option when you logon as Shazam? The account is still live and has not been banned. You just need to remember the email account you used when you first registered your account as the new password will be sent there.

    Did you Google Add Copy Progress Bar ?
    Last edited by biggles77; 12th May 2015, 17:40.
    1 1 was a racehorse.
    2 2 was 1 2.
    1 1 1 1 race 1 day,
    2 2 1 1 2

    Comment


    • #3
      Hi biggles77,

      When I entered my credentials it logs in BUT it goes into an endless connecting loop. I could not scroll down the page, or post, or contact an administrator. I tried logging from home, my iPhone and work. I tried using various internet browsers IE, Firefox, Chrome & Safari. I had no other way but creating a new account. Any help will be appreciated.
      Thanks,
      Last edited by vane0326; 12th May 2015, 18:01.

      Comment


      • #4
        Did you try clearing the cache on one of the browsers and trying again. Your Profile shows there was account activity at 0152 (or close) my time, GMT+10 If the cache clear doesn't work can you get a screen capture or photo and post it here. Ta.
        1 1 was a racehorse.
        2 2 was 1 2.
        1 1 1 1 race 1 day,
        2 2 1 1 2

        Comment


        • #5
          Originally posted by biggles77 View Post
          Did you Google Add Copy Progress Bar ?
          Yes, but I would like to use the "Copy Dialog Box" from the links I posted. I tried using the code in the existing code, but it doesn't work.
          Last edited by vane0326; 12th May 2015, 18:25.

          Comment


          • #6
            Hi Shazam

            You can try this script,

            Code:
            Const FOF_CREATEPROGRESSDLG = &H510&
            
            Dim objShell, sFolderToCopy
            Set objShell = CreateObject("Shell.Application")
            
            sFolderToCopy = "C:\Test"
            
            Set dUSBKeys = ScanForUSBKeys()
            For Each oUSBKey in dUSBKeys.Keys
               sKey = oUSBKey
               If not Right(oUSBKey, 1) = "\" Then sKey = oUSBKey & "\"
            
               CopyTo sKey
            
            Next
            
            Sub CopyTo(Destination)
               Set oDestFldr = objShell.NameSpace(Destination)
               oDestFldr.CopyHere sFolderToCopy, FOF_CREATEPROGRESSDLG
            End Sub
            
            Function ScanForUSBKeys()
               Set oWMI = GetObject("winmgmts:\\.\root\cimv2")
               Set dTemp = CreateObject("Scripting.Dictionary")
            
               Set cDisks = oWMI.ExecQuery("Select InterfaceType,MediaType,PNPDeviceID,DeviceID,Size from Win32_DiskDrive")
               For Each oDisk in cDisks
                 If InStr(LCase(oDisk.InterfaceType),"usb") > 0 AND InStr(LCase(oDisk.MediaType),"removable") > 0 _
                     AND InStr(LCase(oDisk.PNPDeviceID),"blackberry") = 0 AND InStr(LCase(oDisk.PNPDeviceID),"ipod") = 0 _
                     AND NOT oDisk.PNPDeviceID = "" Then
                   Set cDrivePartitions = oWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" & _
                     oDisk.DeviceID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition" )
                   For Each oDrivePartition in cDrivePartitions
                     Set cDriveLetters = oWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" & _
                       oDrivePartition.DeviceID & "'} WHERE AssocClass = Win32_LogicalDiskToPartition")
                     For Each oDriveLetter in cDriveLetters
                       dTemp.Add oDriveLetter.DeviceID, 1
                     Next
                     Set cDriveLetters = Nothing
                   Next
                   Set cDrivePartitions = Nothing
                 End If
               Next
               Set cDisks = Nothing
               Set ScanForUSBKeys = dTemp
               Set dTemp = Nothing
               Set oWMI = Nothing
            End Function

            This posting is provided "AS IS" with no warranties, and confers no rights.

            __________________

            ** Remember to give credit where credit's due **
            and leave Reputation Points for meaningful posts

            Comment


            • #7
              Thank you so much Rems. Perfect as always.


              Hopefully when the Administrators fix my original username...they can replace vane0326 with Shazam on this thread.

              Comment


              • #8
                Hi Rems,

                Is it possible the VBScript can copy and paste the files to the USB drives simultaneously? Right now it's pasting the files to USB drives one at a time.

                Please look at the jpeg attachment. It shows what I'm looking for.
                Attached Files

                Comment


                • #9
                  vane0326/Shazam, could you please post a screen dump of what is happening when you try to logon with your Shazam user account. Thanks.
                  1 1 was a racehorse.
                  2 2 was 1 2.
                  1 1 1 1 race 1 day,
                  2 2 1 1 2

                  Comment


                  • #10
                    Originally posted by biggles77 View Post
                    vane0326/Shazam, could you please post a screen dump of what is happening when you try to logon with your Shazam user account. Thanks.
                    Hi biggles77,

                    I created a little video and posted on my OneDrive account. Here's the link where you can see the video.

                    I do apologize that the video not as focus. You'll notice in the video it doesn't allow me to scroll down.

                    https://onedrive.live.com/redir?resi...nt=video%2cmov

                    Comment


                    • #11
                      Thanks for that. Your Shazam Profile shows you did logon at 2303 on 14th May. It is a weird one.
                      1 1 was a racehorse.
                      2 2 was 1 2.
                      1 1 1 1 race 1 day,
                      2 2 1 1 2

                      Comment


                      • #12
                        Hi Rems,

                        Is it possible to have multiple copy process at the same time when I run your code? I found a link where the op was asking the same thing.

                        http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28166082.html

                        The VBScript will be running on a Window 7 64-bit that has a SSD drive, 18GB of memory and a I7 Quad Core.

                        I don't know if RAMDISK to place the folder in memory would help to speed up the multiple copy process.
                        Last edited by Rems; 20th May 2015, 22:38.

                        Comment


                        • #13
                          I've been thinking on this for some time to see how to speed up the multiple copy process. Here's one way...

                          If any USB flash drive is connected to the computer, have the VBScript open up all USB flash drives using Windows Explorer and then, have the code copy the folder to all active Windows Explorers.

                          Is that possible to make that in a VBScript?


                          I found this code that will open multiple Windows Explorers.
                          Code:
                          set shellApp = createobject("shell.application")
                          set shell = createobject("wscript.shell")
                          shellApp.MinimizeAll
                          shell.run "explorer.exe c:/"
                          shell.run "explorer.exe c:/winnt"
                          wscript.sleep 3000 '<== adjust as needed
                          shellApp.TileVertically

                          Comment

                          Working...
                          X