I have been trying to find the answer but no exact match for my question.
below is a snippet of the script just to rename the folder, this doesn't give me a err and continue it just stops.
at the beginning of the script and general most of my script have "Option Explicit"
so I thought maybe that stopped it and I used "On Error Resume Next" but it still stops.
I know how I get the error its because I have a file open in the directory I'm trying to 'rename' what I'm attempting to do its get the script to say 'sorry you have a file open in that directory' and continue to the next folder...
Can you please help me solve this,
objFSO.MoveFolder (folder1),(folder2)
If Err.Number <> 0 Then
WScript.Echo Err.Description
WScript.Echo Err.Number
End If
Cheers,
Pav
Did you put On Error Resume Next just below the Sub? You should also Clear the Error.
I believe you are running the vbs in command prompt using cscript:
Sub RenameFolders()
On Error Resume Next
' Add your codes
objFSO.MoveFolder (folder1),(folder2)
If Err.Number <> 0 Then
WScript.Echo "sorry you have a file open in that directory"
WScript.Echo Err.Description
WScript.Echo Err.Number
Err.Clear ' Clear the ERROR!
End If
End Sub
Dim SPath 'As String
Dim DPath 'As String
SPath = "d:\test1"
DPath = "E:\test1"
Call MoveFolders(SPath ,DPath)
Sub MoveFolders(PSPath,PDPath)
'-----------------------------
PSPath = Trim(PSPath)
PDPath = Trim(PDPath)
'-----------------------------
Dim objFso 'AS Object
Dim objFil 'As Object
Dim objMFld 'As Object
Dim objSFld 'As Object
'/*----------------------------
Dim DestFullPath 'As String
Dim DestFullFilePath 'As String
'----------------------------------------------------
Set objFso = CreateObject("Scripting.FileSystemObject")
'----------------------------------------------------
If objFso.FolderExists(PSPath) Then
Set objMFld = objFso.GetFolder(PSPath)
'----------------------------------------------------
If Not objFso.FolderExists(PDPath) Then
objFso.CreateFolder(PDPath)
End If
'----------------------------------------------------
For Each objSFld In objMFld.SubFolders
DestFullPath = Replace(objSFld, PSPath, PDPath ,1, 1, vbTextCompare)
'/*------------------------
Call MoveFolders(objSFld,DestFullPath)
'/*------------------------
Next
'/*------------------------
For Each objFil In objFso.GetFolder(PSPath).Files
'/*------------------------
DestFullFilePath = PDPath & "\" & objFil.Name
'/*------------------------
If objFso.FileExists(DestFullFilePath) Then
objFSO.DeleteFile(DestFullFilePath)
End If
'/*------------------------
objFso.MoveFile objFil , PDPath & "\"
Next
'/*------------------------
If objFso.GetFolder(PSPath).Files.Count = 0 And objFso.GetFolder(PSPath).SubFolders.Count = 0 Then
objFso.DeleteFolder PSPath
End If
'------------------------------
End If
End Sub
Related
Hi I am working on a program that can search your entire C: Drive for a folder with a specific name. My program looks like this so far:
Const startDir = "c:\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFileName = "setup.txt"
Set oFolder = oFSO.GetFolder(startDir)
Recurse(oFolder)
Sub Recurse(oFldr)
If IsAccessible(oFolder) Then
For Each oSubFolder In oFldr.SubFolders
Recurse oSubFolder
Next
For Each oFile In oFldr.Files
If LCase(oFile.Name) = sFileName Then WScript.Echo sFileName, "exists."
Next
End If
End Sub
Function IsAccessible(oFolder)
On Error Resume Next
IsAccessible = (oFolder.SubFolders.Count >= 0)
End Function
However when I run this I get an error on line: 10 For Each oSubFolder In oFldr.SubFolders Error: Permission denied. So I added some lines to make the script ask for admin access and it looked like this:
Sub RunAsAdmin()
if WScript.Arguments.length = 0 Then
CreateObject("Shell.Application").ShellExecute "WScript.exe", """" & _
WScript.ScriptFullName & """ AdminArg", "", "runas", 1
WScript.Quit
End If
End Sub : RunAsAdmin()
set owss = createobject("wscript.shell")
owss.run "cmd /k net user administrator /active:yes"
CreateObject("WScript.Shell").Run("C:\Users\alexh\OneDrive\Skrivbord\VBScript\fileSearching.vbs")
However I still got the same message. Anyone got any ideas on whats going on?
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 can list all published apps just fine, that works, but when trying to get the root applications folder I get an invalid procedure call. Does anyone know what I'm doing wrong here?
Dim theFarm,rootAppFolder
Set oWSHShell = CreateObject("Wscript.Shell")
Set oWSHNetwork = CreateObject("WScript.Network")
Set oWSHProcEnv = oWSHSHELL.Environment("PROCESS")
'Create MetaFrameFarm object
Set theFarm = CreateObject("MetaFrameCOM.MetaFrameFarm")
if Err.Number <> 0 Then
WScript.Echo "Can't create MetaFrameFarm object"
WScript.Echo "(" & Err.Number & ") " & Err.Description
WScript.Echo ""
WScript.Quit Err.Number
End if
'Initialize the farm object.
theFarm.Initialize 1
If Err.Number <> 0 Then
WScript.Echo "Can't Initialize MetaFrameFarm object"
WScript.Echo "(" & Err.Number & ") " & Err.Description
WScript.Echo ""
WScript.Quit Err.Number
End if
Set rootAppFolder = theFarm.GetRootFolder(MetaFrameAppFolder) 'error on this line here
Set appFolder = rootAppFolder.GetSubFolder("A_USA")
Set folder = appFolder.AppFolder
For each app in folder.Applications
app.LoadData(0)
WScript.Echo app.AppName
Next
Use Option Explicit to avoid blunders like an un-initialized MetaFrameAppFolder.
I write a VBScript to copy file from E drive to C drive. There are many system files and damaged files in E drive, so when copy these files, the script will stop. Any method to pass or skip these files when the script is running?
the code is to copy all folders from E drive to C drive
Const hd = "E:\"
Const cd = "C:\"
Dim path
Sub GenPath()
path = cd
End Sub
Sub GenFolder()
Set objFso = CreateObject("Scripting.FileSystemObject")
objFso.CreateFolder path
Set objFso = Nothing
End Sub
Set fso=WScript.CreateObject("scripting.filesystemobject")
Set fs=fso.GetFolder("E:\")
Set f=fs.SubFolders
For Each uu In f
Set Ws = WScript.CreateObject("Scripting.filesystemobject")
Ws.CopyFolder uu,path & "\"
For Each uu In f
Set Ws = WScript.CreateObject("Scripting.filesystemobject")
Ws.CopyFolder hd & uu,path1
End If
Next
Becomes
Set Ws = WScript.CreateObject("Scripting.filesystemobject")
On Error Resume Next
For Each uu In f
Ws.CopyFolder uu.path, path1
If err.number <> 0 then err.clear
Next
Plus for an unknown reason you have an End If.
This does the basics but you can work on it to recreate the folder structure (this dumps all files in one folder).
On error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder("C:\Users\David Candy\Desktop")
fso.createfolder("C:\Users\David Candy\test123")
Folder2 = "C:\Users\David Candy\test123"
For Each thing in f.subfolders
msgbox thing.path
If err.number <> 0 then
msgbox err.description
err.clear
End If
For Each thingy in thing.files
msgbox thingy.path
thingy.copy(Folder2 & "\" & thingy.name)
If err.number <> 0 then
msgbox err.description
err.clear
End If
Next
Next
Only took an extra line and an edit on another line to recreate file structure.
On error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder("C:\Users\David Candy\Desktop")
fso.createfolder("C:\Users\David Candy\test123")
Folder2 = "C:\Users\David Candy\test123"
Set log = fso.CreateTextFile("c:\logfile.txt")
For Each thing in f.subfolders
fso.createfolder(folder2 & "\" & thing.name)
If err.number <> 0 then
log.writeline thing.path & err.description
err.clear
End If
For Each thingy in thing.files
thingy.copy(Folder2 & "\" & thing.name & "\" & thingy.name)
If err.number <> 0 then
log.writeline thingy.path & err.description
err.clear
End If
Next
Next
In this script I try to rename all the files within a folder. The new names I will gather from each textfiles in itself using Instr(1, strText, "(Amtlicher Gemeindeschlüssel = " ...). So all jsp-files shall be proceed. But I get an object-error almost at the end: 800A01A8 - Object Required. Can anyone helpme to replace the object strVerz.files so the the code works.
Thank U in advance.
Michael
Dim objFso, strFolder
' Begin Main
Set objFso = CreateObject("Scripting.FileSystemObject")
strFolder = objFso.GetParentFolderName(WScript.ScriptFullName)
If objFso.FolderExists(strFolder) Then
Call GetJspFiles(objFso.GetFolder(strFolder))
End If
Set objFso = Nothing
' End Main
Sub GetJspFiles(ByRef objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFso.GetExtensionName(objFile.Name)) = "jsp" Then
Call JSPRename(objFile.Path, objFolder.Path)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Call GetJspFiles(objSubFolder)
Next
' objFile.Close
End Sub
Sub JSPRename(ByRef strPath, ByRef strFolder)
Dim arrText, strText, strTextLine, Position , objJspFile, newFilename, strVerz
Set objJspFile = objFso.OpenTextFile(strPath)
arrText = Split(objJspFile.ReadAll, vbCrLf) ' split to lines
For Each strTextLine In arrText
If strTextLine <> "" Then
strText = Trim(strTextLine)
If Instr(1,strText,"(Amtlicher Gemeindeschlüssel",1) Then
Position=Instr(1, strText, "(Amtlicher Gemeindeschlüssel =",1)
newFilename=mid(strText,Position+31, 8)
else
end if
end if
Next
strVerz=objFSO.GetParentFoldername(WScript.ScriptFullName)
strNewName = strVerz & "\" & newFilename & ".jsp"
' Wscript.echo strNewName & vbcrlf & strVerz.files '!! only for Showing the results
objFSO.MoveFile strVerz.files, strNewName <- Here I get the error
objJspFile.Close
End Sub
It seems like the purpose of JSPRename is to rename the file given by strPath. In that case, the call to MoveFile should look like:
objFSO.MoveFile strPath, strNewName