• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 499
  • Last Modified:

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

0
dbrs_helpdesk
Asked:
dbrs_helpdesk
  • 6
  • 3
1 Solution
 
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
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
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
 
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

Featured Post

Learn to develop an Android App

Want to increase your earning potential in 2018? Pad your resume with app building experience. Learn how with this hands-on course.

  • 6
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now