Looking to have a vbscript that can copy a folder and its contents to a active usb drive. So the script need to found the active usb drive put in it. Next copy the folder and its contests to the usb drive. Then after the copy job it done need to tell it's finish. There is what I get so far for it.
Const OverWriteFiles = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder "C:\Test" , "?:\Test" , OverWriteFiles 'the "?:\Test" is the part set the usb drive at.
Wscript.Echo "I am Done."
So, what part I really need help with is found out what the active usb drive letter. Next tell is to copy to that usb drive letter.
I know it's not alot of code. But, any info wold be a great help.
This example shows the type of each drive:
Set oFSO = CreateObject("Scripting.FileSystemObject")
sRes = ""
For Each oDrive In oFSO.Drives
sRes = sRes & "DriveLetter: " & oDrive.DriveLetter & ", DriveType: "
Select Case oDrive.DriveType
Case 0
sRes = sRes & "Unknown"
Case 1
sRes = sRes & "Removable"
Case 2
sRes = sRes & "HDD"
Case 3
sRes = sRes & "Network Drive"
Case 4
sRes = sRes & "CD-ROM"
Case 5
sRes = sRes & "RAM-Drive"
End Select
sRes = sRes & vbNewLine
Next
MsgBox sRes
Your script should be like this one:
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objDrive In objFSO.Drives
If objDrive.DriveType = 1 Then
objFSO.CopyFolder "C:\Test" , objDrive.DriveLetter & ":\Test" , True
MsgBox "Copy to " & objDrive.DriveLetter & " Completed"
End If
Next
UPD: Last drive can be found this way:
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objDrive In objFSO.Drives
Set objLastDrive = objDrive
Next
MsgBox objLastDrive.DriveLetter
Well, there may be more than one "active" USB drive. There's nothing stopping me from plugging flash drives into every available USB port on my computer. But here's how you can identify a USB drive (aka, "Removable Drive") on your computer and copy a folder to it with the CopyFolder() function.
Const TYPE_REMOVABLE = 1
With CreateObject("Scripting.FileSystemObject")
For Each Drive In .Drives
If Drive.DriveType = TYPE_REMOVABLE Then
.CopyFolder "C:\Test", Drive.DriveLetter & ":\Test", True
End If
Next
End With
Related
This is my first post, but I have been programming for a long time now
I just want to ask a quick question and the title explains it all. I want my VBS to run a file, but I dont want it to search just for a specific directory, I want it to just find the file if you know what I mean, because if I gave the script to anyone else, this file could be ANYWHERE on their computer.
This is the current couple of important lines that I am using for running files:
set wshshell = wscript.CreateObject("wscript.shell")
and
wshshell.run <program directory here>
You need a recursive function like this one searching for shortcuts.
Sub GenerateHotkeyInFolder(Fldr)
on error resume next
set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set FldrItems=Fldr.Items
For Each oFile in FldrItems
With oFile
If .IsFileSystem = true And .IsLink = true And .Type <> "Shortcut to MS-DOS Program" then
set lnk = WshShell.CreateShortcut(oFile.Path)
If lnk.hotkey <> "" then
Set fsop = fso.GetFile(.Path)
LnkName = "<b>" & fso.GetBaseName(fso.GetFile(.Path)) & "</b><br>" & fsop.ParentFolder.path & "\" & fso.GetBaseName(fso.GetFile(.Path)) & "." & fso.GetExtensionName(fso.GetFile(.Path))
TableVar = TableVar & "<tr><td><b>" & lnk.hotkey & "</b></td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.fullname & Chr(34) & ")'>" & lnkname & "</a>" & "</td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.targetpath & Chr(34) & ")'>" & lnk.targetpath & "</a></td></tr>" & vbcrlf
End If
ElseIf .IsFileSystem = true And .IsFolder = true then
GenerateHotkeyInFolder(.GetFolder)
End If
End With
Next
End Sub
We are trying to create a script to migrate every users profile over in Windows 7 in the case of replacing the PC due to faults etc.
We have been using the following:
Dim fso
Dim oFolder1, objFolder, oFolder
Dim path
Dim colFolders
Dim sDocsAndSettings
Dim strDirectory
Set fso = createobject("Scripting.FileSystemObject")
'===========================================================
'CHANGE SDESTINATION FOLDER PATH HERE
sPath = "C:\Backup"
'===========================================================
Set proFolder = fso.GetFolder(sPath)
'COPY FILES FROM USER PROFILES
sDocsAndSettings = "C:\Users\"
Set colFolders = fso.GetFolder(sDocsAndSettings)
For Each oFolder In colFolders.SubFolders
Select Case LCase(oFolder.Name)
Case "admin", "administrator", "newuser", "all users", "default user", "default user.original", "localservice", "networkservice"
'LEAVE THE DEFAULT PROFILES ON THE MACHINE
Case Else
'MsgBox oFolder.Name
If fso.FolderExists(proFolder) Then
strDirectory = proFolder & "\" & oFolder.Name
If fso.FolderExists(strDirectory) Then
Else
Set objFolder = fso.CreateFolder(strDirectory)
End If
'COPY USER PROFILE FOLDERS to Destination Folder
fso.CopyFolder sDocsAndSettings & oFolder.Name & "\Favorites" , objFolder & "\", True
fso.CopyFolder sDocsAndSettings & oFolder.Name & "\Documents" , objFolder & "\", True
fso.CopyFolder sDocsAndSettings & oFolder.Name & "\Desktop" , objFolder & "\", True
End If
End Select
Next
MsgBox "Backup has been completed successfully!"
Set fso = Nothing
We seem to have hit an issue that aapears to be with the Junction Points (e.g My Documents) in each profile, which is stopping the script with permission errors, as taking the My Documents line out, the script works. Any ideas, or is there a simpler script to migrate profiles over (we need to be able to migrate specific sub-folders).
is the source folder suppose to be "\My Documents" ? it might be looking for a file whihc doesn't exists.
fso.CopyFolder sDocsAndSettings & oFolder.Name & "\Documents" , objFolder & "\", True
I don't know if this makes a differnce but you can alternatively use the object.Copy( destination[, overwrite] ); if you set the overwrite to TRUE, this may make sure that ALL files and folders will be overwritten. Can you also explain the permission issues as "is stopping the script with permission error" is a bit vague.
This is somewhat related to Microsoft System Center Configuration Manager 2007, but it's really about an issue with VBScript, the FileSystemObject API and reading sub-folder properties.
I am trying to run a script to enumerate the folders and folder sizes on one of our Distribution Points (every folder beneath the Package Share). I'm using the FileSystemObject API, with VBscript, I can crawl about 60% of the sub-folders, and get their names and sizes, but then the rest return "error 70 / Permission Denied". It doesn't matter what account I execute the script as, and I've tried adding a Sleep() delay between each sub-folder object reference. It still won't get them all.
If I manually explore the folders, I can view their properties without any problem. Is this a known issue with FSO or maybe Windows Scripting Host? I've attached the script code below. TIA!
'****************************************************************
' Filename..: fso_subfolder_sizes.vbs
' Author....: skatterbrainz
' Date......: 02/10/2013
' Purpose...: enumerate package folders and tally disk space
'****************************************************************
Option Explicit
Const rootFolder = "\\SERVER123\ShareName$"
Dim time1, folderCount, totalSpace
Dim objFSO, objFolder, objSub
Dim GBsize, folderName, folderSIze
time1 = Timer
Set objFSO = CreateObject("Scripting.FileSystemObject")
folderCount = 0
totalSpace = 0
On Error Resume Next
Set objFolder = objFSO.GetFolder(rootFolder)
If err.Number = 0 Then
wscript.echo "<folders>"
For each objSub in objFolder.SubFolders
folderName = objSub.Name
folderSize = objSub.Size
GBsize = FormatNumber(Bytes2Gbytes(folderSize), 2) & " GB"
wscript.echo "<folder name=""" & folderName & """ size=""" & GBsize & """/>"
folderCount = folderCount + 1
totalSpace = totalSpace + folderSize
Next
Set objFolder = Nothing
wscript.echo "</folders>"
wscript.echo "--------------------------"
wscript.echo "sub-folders: " & folderCount
wscript.echo "total space: " & FormatNumber(Bytes2GBytes(totalSpace),2) & " GB"
Else
wscript.echo "root folder not found"
End If
Set objFSO = Nothing
wscript.echo "runtime: " & FormatNumber(Timer - time1, 2) & " Msecs"
Function Bytes2Gbytes(n)
If n > 0 Then
Bytes2Gbytes = (n / 1024 / 1024 / 1024)
Else
Bytes2Gbytes = 0
End If
End Function
Yes this is a known issue, on folders with security issues (like eg your c:\windows folder) you get errors when you use .count of .size on folder. Instead enumerate each file and sum the count and size.
I had the same problem when trying to get profile size of each UserProfile from a share. I used excel and was looping through rows with usernames that I knew had a profile in the share, like this:
strUserName = ActiveCell.Value
objP = "\\SERVER\SHARE$\" & strUserName & "\UPM_Profile"
ActiveCell.Offset(0, 1).Value = (FormatNumber(objFSO.GetFolder(objP).Size, 0, , , 0) / 1024) / 1024
Just some of the thousands folders gave "Path Not Found"
It all worked when I instead mapped the Share to a driveletter:
objP = "Z:\" & strUserName '& "\UPM_Profile"
I found an interesting, yet reproducible behavior with this topic. At least in our production environment: If I specify the root path as the root hidden share (i.e. "\SERVER\Share$") it gets really bogged down. But if I go one level deeper, such as "\SERVER\Share$\Apps") it seems to run much better. I also modified the script to print the sub-folder name first, and THEN query the .Size property, and that seems to point to the performance bottleneck. Note the change in statement ordering in the updated example below...
For each objSub in objFolder.SubFolders
folderName = objSub.Name
wscript.echo vbTab & "<folder>"
wscript.echo vbTab & vbTab & "<folderName>" & folderName & "</folderName>"
folderSize = objSub.Size
GBsize = FormatNumber(Bytes2Gbytes(folderSize), 2) & " GB"
wscript.echo vbTab & vbTab & "<folderSize>" & GBsize & "</folderSize>"
wscript.echo vbTab & "</folder>"
folderCount = folderCount + 1
totalSpace = totalSpace + folderSize
Next
Below is the VBScript code. If the file/s or folder exist I get scripting error, "File already exists".
How to fix that?
How to create folder only if it does not exist and copy files only that are new or do not exist in source path?
How to insert the username (Point 1) after "Welcome" and at (Poin 3) instead of user cancelled?
Can the buttons be changed to Copy,Update,Cancel instead of Yes,No,Cancel? (Point 2)
The code:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
Message = " Welcome to the AVG Update Module" & vbCR '1*
Message = Message & " *****************************" & vbCR & vbCR
Message = Message & " Click Yes to Copy Definition Files" & vbCR & vbCR
Message = Message & " OR " & vbCR & vbCR
Message = Message & " Click No to Update Definition Files." & vbCR & vbCR
Message = Message & " Click Cancel (ESC) to Exit." & vbCR & vbCR
X = MsgBox(Message, vbYesNoCancel, "AVG Update Module") '2*
'Yes Selected Script
If X = 6 then
objFSO.FolderExists("E:\Updates")
if TRUE then objFSO.CreateFolder ("E:\Updates")
objFSO.CopyFile "c:\Docume~1\alluse~1\applic~1\avg8\update\download\*.*",
"E:\Updates\" , OverwriteFiles
MsgBox "Files Copied Succesfully.", vbInformation, "Copy Success"
End If
'No Selected Script
If X = 7 then
objFSO.FolderExists("Updates")
if TRUE then objFSO.CreateFolder("Updates")
objFSO.CopyFile "E:\Updates\*.*", "Updates", OverwriteFiles
Message = "Files Updated Successfully." & vbCR & vbCR
Message = Message & "Click OK to Launch AVG GUI." & vbCR & vbCR
Message = Message & "Click Cancel (ESC) to Exit." & vbCR & vbCR
Y = MsgBox(Message, vbOKCancel, "Update Success")
If Y = 1 then
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\Progra~1\avg\avg8\avgui.exe" & Chr(34), 0
Set WshShell = Nothing
End if
If Y = 3 then WScript.Quit
End IF
'Cancel Selection Script
If X = 2 then
MsgBox "No Files have been Copied/Updated.", vbExclamation, "User Cancelled" '3*
End if
How to create folder only if it does not exist
This your code:
objFSO.FolderExists("E:\Updates")
if TRUE then objFSO.CreateFolder ("E:\Updates")
simply calls the FolderExists and CreateFolder methods in sequence (CreateFolder is always called because the if TRUE condition evaluates to True) and is equal to:
objFSO.FolderExists("E:\Updates")
objFSO.CreateFolder ("E:\Updates")
You want to call CreateFolder depending on the return value of the FolderExists method:
If Not objFSO.FolderExists("E:\Updates") Then
objFSO.CreateFolder "E:\Updates"
and copy files only that are new or do not exist in source path?
Neither VBScript nor the FileSystemObject object have this functionality. However, it is possible to call an external tool that can do that, such as xcopy, from your script using the WshShell.Run method. I guess you need something like this:
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "xcopy c:\Docume~1\alluse~1\applic~1\avg8\update\download\*.* E:\Updates\ /D", , True
How to insert the username (Point 1)
Concatenate the message text with the strUserName variable value:
Message = " Welcome " & strUserName & " to the AVG Update Module" & vbCR
...
MsgBox "No Files have been Copied/Updated.", vbExclamation, strUserName & " Cancelled"
Can the buttons be changed to Copy,Update,Cancel Instead of Yes,No,Cancel?(Point 2)
No, VBScript's built-in MsgBox function does not support custom buttons. There're workarounds though: you could create your custom message box using an HTA (HTML application) or use the InputBox function to prompt the user for the task they wish to perform. You can find examples here.
I'd also like to note that you can improve your script by using the Select Case statement to check the MsgBox return value instead of multiple If...Then...End If statements. Also, it's a bad practice to use "magic numbers" like 6 or 7 - use the appropriate constants instead. For example:
Select Case X
Case vbYes
...
Case vbNo
...
Case Else ' vbCancel
...
End Select
When you say
"copy files only that are new or do
not exist in source path?"
do you mean you only want to copy files from the source directory to the destination directory if they do not exist in the destination? If so this will accomplish that
Const SourceFolder = "C:\Test1\"
Const DestinationFolder = "C:\Test2\"
Set fso = CreateObject("Scripting.FileSystemObject")
'Get a collection of al the files in the source directory
Set fileCol = fso.GetFolder(SourceFolder).Files
'Loop through each file and check to see if it exists in the destination directory
For Each objFile in fileCol
If NOT fso.FileExists(DestinationFolder & objFile.Name) Then
'If the file does not exist in the destination directory copy it there.
objFile.Copy DestinationFolder
Else
If objFile.DateLastModified > fso.GetFile(DestinationFolder & objFile.Name).DateLastModified Then
'If the file is newer than the destination file copy it there
objFile.Copy DestinationFolder, True
End If
End If
Next
Set fileCol = Nothing
Set fso = Nothing
Added the requested date check.
I am trying to update a VBScript (very little experience with this, I do a lot of VB.NET), that reads an FTP directory and moves certain files to a new local directory on a daily basis. I have old code that works on an FTP site that uses anonymous logins, but I now need it to access an FTP site that requires username and password.
Here is my current code -
Sub MoveNSPurolatorFile()
Dim NSPurolatorFTPSite, NSPurolatorMoveFilePath, NSPurolatorFTPFolder, NSPurolatorFTPFileName
Dim folder, files
Dim fso
set fso = CreateObject("Scripting.FileSystemObject")
NSPurolatorFTPSite="\\xxx.xxx.x.xx\"
NSPurolatorMoveFilePath = "F:\TestDirectory"
NSPurolatorFTPFolder = "TestFolder"
NSPurolatorFTPFileName = "MAN0201.CSV"
If InStr(NSPurolatorFTPFileName, "_processed") = 0 and InStr(NSPurolatorFTPFileName, ".CSV") > 0 Then
If fso.FolderExists(NSPurolatorFTPSite & NSPurolatorFTPFolder) Then
If fso.FileExists(NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName) Then
objfile.writeline "NS Purolator File Found: " & NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName
fso.copyFile NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName, NSPurolatorMoveFilePath & "\"
Else
objfile.writeline "File does not exist: " & NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName
End If
End If
End If
Next
End Sub
It says the folder does not exist, but I know it does and when I run this code against an ftp site that does not require username and password it works fine. I guess my question is - How do I pass in the username and password using VBScript to the ftp site before trying to access folders, etc?
Thanks.
This really is an incredibly bad way to do this. You can't just treat folders on a remote FTP site as local folders.
You really should be using InetCtrls.Inet.1
Here's an example I lifted from somewhere else that does not do what you want, but contains all the parts you need - you need to pick it apart to suit your needs.
'Option Explicit
'const progname="FTP upload script by Richard Finegold"
'const url = "ftp://ftp.myftpsite.com"
'const rdir = "mydir"
'const user = "anonymous"
'const pass = "myname#mymailsite.com"
'This is an example of ftp'ing without calling the external "FTP" command
'It uses InetCtrls.Inet.1 instead
'Included is a "hint" for simple downloading
'Sources:
'http://msdn.microsoft.com/library/partbook/ipwvb5/loggingontoftpserver.htm
'http://msdn.microsoft.com/library/partbook/egvb6/addinginternettransfercontrol.htm
'http://cwashington.netreach.net/ - search on "ftp" - inspiration only!
'Insist on arguments
dim objArgs
Set objArgs = Wscript.Arguments
If 0=objArgs.Count Then
MsgBox "No files selected for operation!", vbOkOnly + vbCritical, progname
WScript.Quit
End If
'Force console mode - csforce.vbs (with some reorganization for efficiency)
dim i
if right(ucase(wscript.FullName),11)="WSCRIPT.EXE" then
dim args, y
For i = 0 to objArgs.Count - 1
args = args + " " + objArgs(i)
Next
Set y = WScript.CreateObject("WScript.Shell")
y.Run "cscript.exe " & wscript.ScriptFullName + " " + args, 1
wscript.quit
end if
'Do actual work
dim fso, ftpo
set fso = WScript.CreateObject("Scripting.FileSystemObject")
set ftpo = WScript.CreateObject("InetCtls.Inet.1") 'Msinet.ocx
ftpo.URL = url
ftpo.UserName = user
ftpo.Password = pass
WScript.Echo "Connecting..."
ftpo.Execute , "CD " & rdir
do
' WScript.Echo "."
WScript.Sleep 100 'This can take a while loop while ftpo.StillExecuting
for i = 0 to objArgs.Count - 1
dim sLFile
sLFile = objArgs(i)
if (fso.FileExists(sLFile)) then
WScript.Echo "Uploading " & sLFile & " as " & FSO.GetFileName(sLFile) & " "
ftpo.Execute , "Put " & sLFile & " " & FSO.GetFileName(sLFile)
'ftpo.Execute , "Get " & sRemoteFile & " C:\" & sLFile
do
'WScript.Echo "."
WScript.Sleep 100 'This can take a while
loop while ftpo.StillExecuting
else
MsgBox Chr(34) & sLFile & Chr(34) & " does not exist!", _
vbOkOnly, progname
end if
next
WScript.Echo "Closing"
ftpo.Execute , "Close"
WScript.Echo "Done!"
Here's a pretty nice way to do it - I'm sure this could be improved upon, but I just got it going.. :-)
Dim fso, folder1, folder2, folder2a
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder2a = fso.GetFolder("C:\temp")
ftpFolderString = "ftp://username:password#ftp.ftpsite.com/folderpath"
targetFoldder = "C:\temp"
fileSearchStr = "searchstring"
Dim SH, txtFolderToOpen, thing
Set SH = CreateObject("Shell.Application")
'SH.Open txtFolderToOpen
Set folder1 = SH.NameSpace(ftpFolderString)
Set folder2 = SH.NameSpace(targetFoldder)
For Each item In folder1.items
If InStr(LCase(item.Name),fileSearchStr) > 0 Then
Debug.WriteLine item.Name
folder2.CopyHere item,4
WScript.Sleep(200)
For Each item2 In folder2a.Files
If item2.Name = item.Name Then
While item2.Size < item.Size
WScript.Sleep(200)
Wend
End If
Next
WScript.Sleep(200)
End If
Next
Set SH = Nothing
Debug.WriteLine "Done"
How is the script being run? Manually, automatically? By a service?
Mapped-letter drives are not always available when running as a service.
Experiment with the script to ensure that it even able to see the F:\ drive, and then see what else is visible.
Is the FTP site accessed by a UNC path (looks like it is)? If it is just a standard FTP address then you can incorporate the username / password in the URL e.g. ftp://user:pass#myftpsite.com. If it is a UNC path that you are trying to access using different credentials then the easiest way would probably be to map a drive, do the work and then unmap the drive. 2 different approaches can be found here