Transfering files based on Date stamp onto USB key using VB script

Hi guys,

I posted this question before and I need a bit more help.  ID Number 23127335 Transfering files based on Date stamp using VB script.  I have listed the code that I have below.
If (IsMember(objUser, "TEST") = True) Then   ' Change the group name (TEST) to the proper group name
 
' **************************** Enter variables and hard code the path to where the files are located ***************************
 
 
function getParent()
	fPath="\\bluewater\departments$\test\"
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set oFolder = oFSO.GetFolder(fPath)
	set oSubfolders = oFolder.Subfolders
 
 
' ****************************************  Prompt to enter USB key  ***********************************
 
 
InputBox ("Please enter your usb key and press the enter key to continue")
 
 
 
' ******************************************* The code below will find the usb device  *************************************
 
 
On Error Resume Next
 
strComputer = "."
 
 
arrDriveType = array("Unknown",_
		     "No Root Directory",_
		     "Removable Disk",_
		     "Local Disk",_
		     "Network Drive",_
		     "Compact Disk",_
		     "RAM Disk")
 
set WMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
set colDisks = WMI.ExecQuery("Select * from Win32_LogicalDisk")
 
For Each Disk in ColDisks
	strType = arrDriveType(Disk.DriveType)
	strID = Disk.DeviceID
	strSys = Disk.SystemName
 
	
 
' ********************* IF no removable usb device found then go to end   ********************************************
 
 
If strType = ********  nothing  ****** then
goto :EOF
 
 
' *************************  The code below will replace the files  **************************************
 
	
	for each oSubfolders in oSubfolders
		filePath=GetNewestFile(oSubfolders)
		if(instr(filePath, sToday)) then
			fileName = re.replace(GetFilenameFromPath(filePath),"")
			oFSO.CopyFile filePath , "\\bluewater\departments$\test\" & fileName , OverwriteExisting
		else
			 Set objTextFile = oFSO.OpenTextFile _
(fPath & "exception" & date() & ".txt", ForAppending, True)
objTextFile.WriteLine("output data")
objTextFile.Close
		end if
	next 
end function
 
 
EOF
 
end

Open in new window

dbrs_helpdeskAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Shanmuga SundaramDirector of Software EngineeringCommented:
Had you checked this link for checking the newer files using vbscript

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_22388669.html
0
dbrs_helpdeskAuthor Commented:
This is using an hourly check, I do not need the hourly check.  All I require is a check apon logon.  I almost have the code but I need a bit more help with it.  

The section I am working on is finding out what the drive letter is and putting it in the section .

If strType = "Removable Disk" then

strMbox = MsgBox("USB drive letter is")
end if

If strMbox = 1 Then
strMbox ="."
End If


 
If (IsMember(objUser, "TEST") = True) Then   ' Change the group name (TEST) to the proper group name
 
' **************************** Enter variables and hard code the path to where the files are located ***************************
 
 
function getParent()
	fPath="\\bluewater\departments$\test\"
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set oFolder = oFSO.GetFolder(fPath)
	set oSubfolders = oFolder.Subfolders
 
 
' ****************************************  Prompt to enter USB key  ***********************************
 
 
Option Explicit
Dim strComputer, strMbox
'On Error Resume Next
strMbox = "."
strMbox = MsgBox("Please enter your usb key and press the enter key to continue")
If strMbox = 1 Then
strMbox ="."
End If
   
 
 
' ******************************************* The code below will find the usb device  *************************************
 
 
On Error Resume Next
 
strComputer = "."
 
 
arrDriveType = array("Unknown",_
		     "No Root Directory",_
		     "Removable Disk",_
		     "Local Disk",_
		     "Network Drive",_
		     "Compact Disk",_
		     "RAM Disk")
 
set WMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
set colDisks = WMI.ExecQuery("Select * from Win32_LogicalDisk")
 
For Each Disk in ColDisks
	strType = arrDriveType(Disk.DriveType)
	strID = Disk.DeviceID
	strSys = Disk.SystemName
 
If strType = "Removable Disk" then
 
strMbox = MsgBox("USB drive letter is") 
end if
 
If strMbox = 1 Then
strMbox ="."
End If
Next
 
' ********************* IF no removable usb device found then go to end   ********************************************
 
 
If strType = "." then
goto :EOF
End IF
 
' *************************  The code below will replace the files  **************************************
 
	
	for each oSubfolders in oSubfolders
		filePath=GetNewestFile(oSubfolders)
		if(instr(filePath, sToday)) then
			fileName = re.replace(GetFilenameFromPath(filePath),"")
			oFSO.CopyFile filePath , "\\bluewater\departments$\test\" & fileName , OverwriteExisting
		else
			 Set objTextFile = oFSO.OpenTextFile _
(fPath & "exception" & date() & ".txt", ForAppending, True)
objTextFile.WriteLine("output data")
objTextFile.Close
		end if
	next 
end function
 
 
EOF
 
End if
 
end 

Open in new window

0
RobSampsonCommented:
If you change this:
MsgBox("USB drive letter is")

to this
MsgBox("USB drive letter is" & strID)

Does that tell you which drive letter it has found?

Regards,

Rob.
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

dbrs_helpdeskAuthor Commented:
I got it all working.  I have one little issue.  When you run the program with no usb key it gives an error.  How do I tell it to end if there is no USB Key?

Option Explicit
'Dim objWMIService, objItem, colItems
Dim strComputer, strMbox, ArrDriveType, WMI, coldisks, disk, strtype, strID, strSys, UsbKey, file
Dim objFSO:Set objFSO=CreateObject("Scripting.FileSystemObject")
Dim objFolderA: Set objFolderA=objFSO.GetFolder("\\bluewater\departments$\Information Technology\test\")
 
 
 
 
strMbox = "."
 
strMbox = msgBox("Please enter your usb key and press the enter key to continue")
 
If strMbox = 1 Then
 
	strmbox ="."
 
end if
 
strComputer = "."
 
 
arrDriveType = array("Unknown",_
            "No Root Directory",_
            "Removable Disk",_
            "Local Disk",_
            "Network Drive",_
            "Compact Disk",_
            "RAM Disk")
 
set WMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
set colDisks = WMI.ExecQuery("Select * from Win32_LogicalDisk")
 
For Each Disk in ColDisks
  
  	strType = arrDriveType(Disk.DriveType)
   	strID = Disk.DeviceID
  	strSys = Disk.SystemName
 
 
	If strType = "Removable Disk" then
 
	      strMbox = MsgBox("USB drive letter is " & Disk.DeviceID)
      	      UsbKey = strId & "\"
  end if
 
 
Next 
 
For Each file in objFolderA.Files
If dateDiff("d", file.DateCreated, Date) < 2 Then 'copy file if it's "2 days old"
   MsgBox "objFSO.CopyFile " & file.Path & ", " & UsbKey
   objFSO.CopyFile file.Path, UsbKey
End If
 
Next 
 
'For Each file in objFolderA.Files
 
'	If datediff("h", file.datecreated, now) < 1 Then 
'		objFSO.CopyFile file.Path, UsbKey
'  	End If
'Next
 
Set objFSO=Nothing

Open in new window

0
RobSampsonCommented:
Change this:
For Each Disk in ColDisks

      strType = arrDriveType(Disk.DriveType)
      strID = Disk.DeviceID
      strSys = Disk.SystemName

      If strType = "Removable Disk" then

            strMbox = MsgBox("USB drive letter is " & Disk.DeviceID)
            UsbKey = strId & "\"
      End If

Next

to this:
boolFound = False
For Each Disk in ColDisks

      strType = arrDriveType(Disk.DriveType)
      strID = Disk.DeviceID
      strSys = Disk.SystemName

      If strType = "Removable Disk" then

            strMbox = MsgBox("USB drive letter is " & Disk.DeviceID)
            UsbKey = strId & "\"
            boolFound = True
      End If

Next
If boolFound = False Then
      MsgBox "No USB drive was found."
      WScript.Quit
End If


Regards,

Rob.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
dbrs_helpdeskAuthor Commented:
The code semi works.  It runs and gives me an error with an unexpected next statement.  Then if I comment out the next it always says that there is no usb device found.  I also changed your boolfound to usbfound and declared it.
USBFound = False
For Each Disk in ColDisks
 
      strType = arrDriveType(Disk.DriveType)
      strID = Disk.DeviceID
      strSys = Disk.SystemName
 
      If strType = "Removable Disk" then
 
            strMbox = MsgBox("USB drive letter is " & Disk.DeviceID)
            UsbKey = strId & "\"
            USBFound = True
      End If
 
Next
 
If USBFound = False Then
      MsgBox "No USB drive was found."
      WScript.Quit
End If

Open in new window

0
dbrs_helpdeskAuthor Commented:
The code posted below for that section works.





For Each Disk in ColDisks

      strType = arrDriveType(Disk.DriveType)
      strID = Disk.DeviceID
      strSys = Disk.SystemName

      If strType = "Removable Disk" then

            strMbox = MsgBox("USB drive letter is " & Disk.DeviceID)
            UsbKey = strId & "\"
            USBFound = True
      End If

Next

If USBFound = False Then
      MsgBox "No USB drive was found."
      WScript.Quit
End If




For Each file in objFolderA.Files
If dateDiff("d", file.DateCreated, Date) < 2 Then 'copy file if it's "2 days old"
   MsgBox "objFSO.CopyFile " & file.Path & ", " & UsbKey
   objFSO.CopyFile file.Path, UsbKey
End If

Thank you very much
0
dbrs_helpdeskAuthor Commented:
All I can say is Genius.
0
dbrs_helpdeskAuthor Commented:
One last question for you.  What if I wanted to copy all the files in the folder just based on what is newer not less then and hour.

If datediff("h", file.datecreated, now) < 1 Then
'            objFSO.CopyFile file.Path, UsbKey
'        End If
0
RobSampsonCommented:
Yeah, that should work, although maybe you want to use
If datediff("h", file.DateLastAccessed, now) < 1 Then

or
If datediff("h", file.DateLastModified, now) < 1 Then

Regards,

Rob.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Scripting Languages

From novice to tech pro — start learning today.