I have the following VBScript to which I'm trying to add to, but I need help in how to do it.
At present I have the script below that asks for the file name I want it to be called and then creates a folder and moves of which ok.
What I'm trying to add is after the folder is created I need a command box with the YES/NO option and if I click YES I need the file moved to C:\DOCUMENTS\A and if NO I need it moved to C:\DOCUMENTS\B.
Once I've clicked YES or NO and it has moved the folder I need to open Folder A or B to view.
Any Ideas?
Option Explicit
Const strDLFolder = "C:\Downloads"
Dim objFSO, objWShell, objDLFolder, strNewFolder, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWShell = CreateObject("WScript.Shell")
If Not objFSO.FolderExists(strDLFolder) Then objFSO.CreateFolder(strDLFolder)
objWShell.CurrentDirectory = strDLFolder
Set objDLFolder = objFSO.GetFolder(strDLFolder)
If objDLFolder.Files.Count = 0 Then WScript.Quit
Do
Err.Clear
strNewFolder = InputBox("Folder Name", vbLf & "Enter the name of the folder to be created:")
If strNewFolder = False Then WScript.Quit
On Error Resume Next
objFSO.CreateFolder strNewFolder
Loop While Err.Number <> 0 Or Not objFSO.FolderExists(strNewFolder)
On Error Goto 0
For Each objFile In objDLFolder.Files
objFSO.MoveFile objFile.Name, strNewFolder & "\"
Next
objWShell.Popup "All files moved.", 0, "Done", vbInformation Or vbSystemModal Or &h00040000&
Related
In continuation of Call VBScript from Windows Explorer Context Menu, I managed to get a VBScript file running from SendTo in the Windows Explorer.
I've changed my code to copy the file that invokes the script to my Temp folder. The new problem is that if the path is over 256 characters, I can't loop through WScript.Arguments to get all of it. Is there another way to get the full path (including the file name and it's extension)?
Option Explicit
Call OpenDocuWorksFile
Sub OpenDocuWorksFile()
Const sTitle = "Open DocuWorks File"
Dim iArgumentsCount
Dim iArgument
Dim sFilePath
Dim sTempFolder
Dim oFileScriptingObject
Dim sFileName
Dim oShell
iArgumentsCount = WScript.Arguments.Count
On Error Resume Next
For iArgument = 0 To iArgumentsCount
sFilePath = sFilePath & WScript.Arguments(iArgument)
Next
On Error GoTo 0
Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
With oFileScriptingObject
sFileName = .GetFileName(sFilePath)
sTempFolder = oFileScriptingObject.GetSpecialFolder(2) 'Temp Folder
If .GetExtensionName(sFileName) = "xdw" Then
.CopyFile sFilePath, sTempFolder & "\", True 'Overwrite
Set oShell = CreateObject("Shell.Application")
oShell.Open sTempFolder & "\" & sFileName
Else
MsgBox "Please select a DocuWorks file.（.xdw)", vbCritical, sTitle
End If
End With
Set oFileScriptingObject = Nothing
Set oShell = Nothing
End Sub
I was trying to build a VBS to test creating files because a larger script I wrote isn't creating an output file. The point of the following script is to test functionality; which I'm not currently seeing.
Option Explicit
Dim objFSO, objFSOText, objFolder, objFile
Dim strDirectory, strFile
strDirectory = "C:\Test\next"
strFile = "\Try.txt"
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Create the Folder specified by strDirectory on line 10
Set objFolder = objFSO.CreateFolder(strDirectory)
' -- The heart of the create file script
'-----------------------
'Creates the file using the value of strFile on Line 11
' -----------------------------------------------
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
Wscript.Echo "Just created " & strDirectory & strFile
Wscript.Quit
While running this code, everything works the first time but there isn't an output file in the destination directory. When I run it again it throws an error that the file already exists.
I think the problem is that you are trying to create the path "C:\Test\next", which is a structure of two nested folders) in one go and also do not test if that path already exists.
To create a nested folder structure, I have added a small helper function CreateNestedFolder to your code and tidied it up a bit:
Option Explicit
Dim strDirectory, strFile, overwrite
strDirectory = "C:\Test\next"
strFile = "Try.txt"
overwrite = True 'set this to False if you do not wish to overwrite an existing file
'Create the (nested) Folder Structure specified by strDirectory if it does not exist yet
If Not CreateNestedFolder(strDirectory) Then
Wscript.Echo "Could not create folder " & strDirectory
Else
Dim objFSO, objFile
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' -- The heart of the create file script
'-----------------------
'Creates the file using the value of strFile
' -----------------------------------------------
'combine the directory and filename
strFile = strDirectory & "\" & strFile
'Create the new file and write something in it
Set objFile = objFSO.CreateTextFile(strFile, overwrite)
objFile.WriteLine("This is a test.")
objFile.Close
Wscript.Echo "Just created " & strFile
'Clean up the used objects
Set objFile = Nothing
Set objFSO = Nothing
End If
Function CreateNestedFolder(ByVal sPath)
'Helper function to create a nested folder structure.
'Returns True on success, False otherwise
Dim aFolders, oFso, i, firstIndex
On Error Resume Next
Set oFso = CreateObject("Scripting.FileSystemObject")
'Check if the path already exists
If Not oFso.FolderExists(sPath) Then
'Find the root drive and split the path in subfolder parts
aFolders = Split(sPath, "\")
'Get the root path from the complete path
If Left(sPath, 2) = "\\" Then
'If this is a UNC path then the root will be "\\server\share"
sPath = "\\" & aFolders(2) & "\" & aFolders(3)
firstIndex = 4
Else
'For a local path, the root is "X:"
aFolders = Split(sPath, "\")
sPath = aFolders(0)
firstIndex = 1
End If
'Loop through the aFolders array and create new folders if needed
For i = firstIndex to UBound(aFolders)
If Len(aFolders(i)) > 0 Then
sPath = sPath & "\" & aFolders(i)
If Not oFso.FolderExists(sPath) Then oFso.CreateFolder sPath
End If
Next
End If
CreateNestedFolder = (Err.Number = 0)
On Error GoTo 0
Set oFso = Nothing
End Function
I am at my wits end into this. Either I am doing it the wrong way or it is not possible.
I need a vb script for the following scenario:
The script is to run on multiple Windows 7 machines (32-Bit & 64-Bit alike).
These are shared workstation i.e. different users login to these machines from time to time.
The objective of this script is to traverse through each User Profile folder and get the size of the 'My Documents' folder within each User Profile folder. This information is to be written to a .CSV file located at C:\Temp directory on the machine.
This script would be pushed to all workstations from SCCM. It would be configured to execute with System Rights
I tried the script detailed at:
http://blogs.technet.com/b/heyscriptingguy/archive/2005/03/31/how-can-i-determine-the-size-of-the-my-documents-folder.aspx
Const MY_DOCUMENTS = &H5&
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_DOCUMENTS)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objFolder = objFSO.GetFolder(strPath)
Wscript.Echo objFolder.Size
The Wscript.Echo objFolder.Size command in the script returned the value as '0' (zero) for the current logged on user. Although the actual size was like 30 MB or so.
I then tried the script at:
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_27869829.html
This script returns the correct value but only for the current logged-on user.
Const blnShowErrors = False
' Set up filesystem object for usage
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
' Display desired folder sizes
Wscript.Echo "MyDocuments : " & FormatSize(FindFiles(objFSO.GetFolder(objShell.SpecialFolders("MyDocuments"))))
' Recursively tally the size of all files under a folder
' Protect against folders or files that are not accessible
Function FindFiles(objFolder)
On Error Resume Next
' List files
For Each objFile In objFolder.Files
On Error Resume Next
If Err.Number <> 0 Then ShowError "FindFiles:01", objFolder.Path
On Error Resume Next
FindFiles = FindFiles + objFile.Size
If Err.Number <> 0 Then ShowError "FindFiles:02", objFile.Path
Next
If Err.Number = 0 Then
' Recursively drill down into subfolder
For Each objSubFolder In objFolder.SubFolders
On Error Resume Next
If Err.Number <> 0 Then ShowError "FindFiles:04", objFolder.Path
FindFiles = FindFiles + FindFiles(objSubFolder)
If Err.Number <> 0 Then ShowError "FindFiles:05", objSubFolder.Path
Next
Else
ShowError "FindFiles:03", objFolder.Path
End If
End Function
' Function to format a number into typical size scales
Function FormatSize(iSize)
aLabel = Array("bytes", "KB", "MB", "GB", "TB")
For i = 0 to 4
If iSize > 1024 Then iSize = iSize / 1024 Else Exit For End If
Next
FormatSize = Round(iSize, 2) & " " & aLabel(i)
End Function
Sub ShowError(strLocation, strMessage)
If blnShowErrors Then
WScript.StdErr.WriteLine "==> ERROR at [" & strLocation & "]"
WScript.StdErr.WriteLine " Number:[" & Err.Number & "], Source:[" & Err.Source & "], Desc:[" & Err.Description & "]"
WScript.StdErr.WriteLine " " & strMessage
Err.Clear
End If
End Sub
The only part pending, is to achieve this for the 'My Documents' folder within each of the other User Profile folders.
Is this possible?
Please help.
This is my first post so please excuse my ignorance. I am using a vbscript to zip all .csv type files in a particular folder. After some google searches, I have found a workable vbscript to do this and have enabled a scheduled task to automate this.
What I need to do next is to transfer the zip file via sftp and then "move" that zip file into another folder. I believe the former can be achieved using pscp.exe via command line but can someone show me how to do the latter?
Basically the zipping will be done twice a day and so it will have a timestamp similar to yyyymmdd0900.zip (for 9am schedule) and yyyymmdd1800.zip (for 6pm schedule). After the transfer, I want to move (not copy) the zip file generated into another folder.
Any pointers would be greatly appreciated. Thank you all in advance.
EDIT: Here is some code I slapped together based on some Google searches. It does what I want it to do. Please excuse the "pasting" as i couldn't figure out how to format it properly. Currently, it runs the bat file after copying but I just noticed that i need to send (using PuTTY Secure Copy) the "latest" zip file before moving it to the "completed" folder. Can someone please show me how to do this?
Zipping the file and rename the zip file
My Code :
On Error Resume Next
strFilepath = "c:\files"
strDestination = "c:\files\completed\"
strExtension = "csv"
strYear = Year(Now)
strMonth = Right("0" & Month(Now), 2)
strDay = Right("0" & Day(Now), 2)
strHour = Right ("0" & Hour(Now), 2)
strMinute = Right ("0" & Minute (Now), 2)
strZip = strFilepath & "\" & strYear & strMonth & strDay & strHour & strMinute & ".zip"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFilepath)
For Each objFile in objFolder.Files
strFileExt = objFSO.GetExtensionName(objFile.Path)
If LCase(strFileExt) = LCase(strExtension) Then
ZipFile objFile.Path, strZip
End If
Next
Sub ZipFile(strFileToZip, strArchive)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(strArchive) Then
Set objTxt = objFSO.CreateTextFile(strArchive)
objTxt.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
objTxt.Close
End If
Set objApp = CreateObject( "Shell.Application" )
intCount = objApp.NameSpace(strArchive).Items.Count + 1
objApp.NameSpace(strArchive).CopyHere strFileToZip
Do
WScript.Sleep 200
set objNameSpace = objApp.NameSpace(strArchive)
If Not objNameSpace is nothing Then
If objNameSpace.Items.Count = intCount Then
Exit Do
End If
End If
Loop
End Sub
>Move file to a different folder and then run a bat file to secury copy file to a FTP location
'Vars
Dim objFSO, objFileCopy, objFileDelete, dot, files, file
Dim strDestination, folder, subfolder, fileCount, strFilePath
'Strings
strDestination = "C:\Files\Completed\"
strFilePath = "C:\Files"
set objFSO = CreateObject("Scripting.fileSystemObject")
set folder = objFSO.getFolder(strFilePath)
For Each file In folder.files
Set objFileCopy = objFSO.GetFile(file)
If objFSO.GetExtensionName(file) = "zip" Then
objFSO.MoveFile objFileCopy.Path, strDestination
End If
Next
Dim shell
Set shell=createobject("wscript.shell")
Shell.run "C:\testsend.bat"
Set shell=nothing
This will move a file to the specified location.
Sub Move_File(Source_File, Destination_Folder)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile Source_File, Destination_Folder
Set fso = Nothing
End Sub
sftp client provides a means to change working directory on the host before performing any file transfers. It would be better to thus transfer the file directly to the target location.
NOTE: The above answer was a result of misunderstanding the question. I read it to mean the file had to be moved on the destination but the real operation was to move the file on the origin.
I found the following example code that moves a file after checking that it exists. Wildcards are allowed for the source parameter but then FileExists may not work. Requires vbscript 2.0 to work.
<%
dim filesys
set filesys=CreateObject("Scripting.FileSystemObject")
If filesys.FileExists("c:\sourcefolder\anyfile.html") Then
filesys.MoveFile "c:\sourcefolder\anyfile.html", "c:\destfolder\"
End If
%>
In my code segment, when I script the file name, it gives me a permission denied
on the following line:
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
Here is the script
'output log info
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\eNet"
strFile = "\weeklydel.bat"
'strText = "Book Another Holiday"
strText = strToAdd
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 2
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
I have assigned the vbscript domain administrator permissions. Any ideas?
thanks in advance
I don't think this has to do with File Permissions per se. It has to do with the fact that you've created the file using:
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
That creates the file...and carries a reference to that file (objFile)
Then you don't close the file before you destroy the reference
...
'Missing objFile.Close here
Set objFile = nothing
Set objFolder = nothing
...
Consequently you're destroying the reference but leaving the textstream open in memory thus locking your file.
You are then proceeding to attempt to re-open the file while the file is already "open". This is a little long winded, you've already got a reference after you've created the file - it would be easier just to write straight to that rather than destroy the reference before creating another one.
for what its worth...
I was convinced I had a permission error because of this line:
Set LogFile = LogFSO.OpenTextFile(LogFileName, ForWriting, True)
Because that's the line that the 'permission denied' error pointed to. But in fact, my permission error was a few lines further down:
WshShell.AppActivate(ScreensToRemove(i))
WshShell.SendKeys ("~")
WScript.Sleep(1000)
There was no screen with such a caption, so the SendKeys is what did not have permission.
The solution, of course, was:
If WshShell.AppActivate(ScreensToRemove(i)) = True Then
WshShell.SendKeys ("~")
WScript.Sleep(1000)
End if
Hope that might help.
Also, make sure that you don't have the file open in Excel (I had this problem with a .csv file)...
In my particular case the file which existed before and all I had to do was give permission to the Everyone user
balabaster is exactly right. You either need to close the file before reopening it a second time for writing, or using the existing open handle.