I want to replicate specific files from my desktop to my notebook through a network share over a basic workgroup. When I run this script the files from DestinationFolder2 replicate successfully; however, the files from DestinationFolder replicate only intermittently, sometimes returning the error "Path not found, Line 40, Column 7 (referring to * fso.CopyFolder SourceFolder, "\Resource\Desktop", True)". Any suggestions?
ServerShare = "\\Resource\Desktop"
ServerShare2 = "\\Resource\Documents and Settings\User\SendTo"
Set NetworkObject = CreateObject("WScript.Network")
Set FSO = CreateObject("Scripting.FileSystemObject")
NetworkObject.MapNetworkDrive "", ServerShare, False, UserName, Password
NetworkObject.MapNetworkDrive "", ServerShare2, False, UserName, Password
Set Directory = FSO.GetFolder(ServerShare)
For Each FileName In Directory.Files
WScript.Echo "Files Copied: ", FileName.Name
Next
Set Directory = FSO.GetFolder(ServerShare2)
For Each FileName In Directory.Files
WScript.Echo "Files Copied2: ", FileName.Name
Next
Set FileName = Nothing
Set Directory = Nothing
Set FSO = Nothing
NetworkObject.RemoveNetworkDrive ServerShare, True, False
NetworkObject.RemoveNetworkDrive ServerShare2, True, False
Set ShellObject = Nothing
Set NetworkObject = Nothing
Const DestinationFolder = "\\Resource\Desktop"
Const DestinationFolder2 = "\\Resource\Documents and Settings\User\SendTo"
Const SourceFolder = "C:\Documents and Settings\User.MACHINE\Desktop"
Const SourceFolder2 = "C:\Documents and Settings\User.MACHINE\SendTo"
Set fso = CreateObject("Scripting.FileSystemObject")
'Check to see if the file already exists in the destination folder
If fso.FolderExists(DestinationFolder) Then
'Check to see if the file is read-only
If Not fso.GetFolder(DestinationFolder).Attributes And 1 Then
'The file exists and is not read-only. Safe to replace the file.
fso.CopyFolder SourceFolder, "Resource\Desktop", True
Else
'The file exists and is read-only.
'Remove the read-only attribute
fso.GetFolder(DestinationFolder).Attributes = fso.GetFolder (DestinationFolder).Attributes - 1
'Replace the file
fso.CopyFolder SourceFolder, "\\Resource\Desktop", True
'Reapply the read-only attribute
fso.GetFolder(DestinationFolder).Attributes = fso.GetFolder (DestinationFolder).Attributes + 1
End If
Else
'The file does not exist in the destination folder. Safe to copy file to this folder.
fso.CopyFolder SourceFolder, "\\Resource\Desktop", True
End If
If fso.FolderExists(DestinationFolder2) Then
'Check to see if the file is read-only
If Not fso.GetFolder(DestinationFolder2).Attributes And 1 Then
'The file exists and is not read-only. Safe to replace the file.
fso.CopyFolder SourceFolder2, "Resource\Documents and Settings\User\SendTo", True
Else
'The file exists and is read-only.
'Remove the read-only attribute
fso.GetFolder(DestinationFolder2).Attributes = fso.GetFolder (DestinationFolder2).Attributes - 1
'Replace the file
fso.CopyFolder SourceFolder2, "Resource\Documents and Settings\User\SendTo", True
'Reapply the read-only attribute
fso.GetFolder(DestinationFolder2).Attributes = fso.GetFolder (DestinationFolder2).Attributes + 1
End If
Else
'The file does not exist in the destination folder. Safe to copy file to this folder.
fso.CopyFolder SourceFolder2, "\\Resource\Documents and Settings\User\SendTo", True
End If
Set fso = Nothing
Related
I'm trying to delete those folders that are empty with a triple loop.
The order is:
1. Enter into the Main Folder.
2. Check the first encountered folder
3. Check the first subFolder of the main folder.
4. If that subFolder contains another folder, enter in this subSubFolder
5. If it is the last folder and doesn't contain anything, the program deletes it.
5.1 If the folder contains something (a file, excel, pdf, doesn't matter) just go to the next subSubFolder.
6. And goes on until there's no empty folders.
Basically the code must leave untouched the folders that contains a File.
But i don't know why the code doesn't continue and just stop without deleting the empty ones.
This is the Folder Structure:
Folder Path
And this is the code i'm using.:
Sub recursiveDeleting()
Dim sFldr As Object
Dim ssFldr As Object
Dim sssFldr As Object
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
sFound = False
ssFound = False
sssFound = False
flPath = ActiveWorkbook.Path & "\"
YearPath = flPath & "2017\"
FARFIpath = YearPath & "\FAR_FI\"
For Each sFldr In CreateObject("Scripting.FileSystemobject").GetFolder(FARFIpath).SubFolders
For Each ssFldr In CreateObject("Scripting.FileSystemobject").GetFolder(sFldr).SubFolders
For Each sssFldr In CreateObject("Scripting.FileSystemobject").GetFolder(ssFldr).SubFolders
If Dir(sssFldr & "\*.*") = "" Then
RmDir (sssFldr)
Else
sssFound = True
End If
If sssFound = True Then
Exit For
End If
Next sssFldr
If fs.FolderExists(ssFldr) = "" Then
RmDir (ssFldr)
Else
ssFound = True
End If
If ssFound = True Then
Exit For
End If
Next ssFldr
If Dir(sFldr, vbDirectory) = "" Then
RmDir (sFldr)
sFound = True
End If
If sFound = True Then
Exit For
End If
Next sFldr
End Sub
Thanks for your time and have a good day!
Try below code, tested working (it will delete the root folder as well if it's empty afterwards. It can be mind blogging if you are to trace back the recursive code.
Sample - only a blank text file in highlighted folder (all others has no files).
Option Explicit
Private oFSO As Object
Sub DeleteEmptyFolder()
Dim oRootFDR As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oRootFDR = oFSO.GetFolder("C:\Test\mount") '<--- Change to your root folder
If DeleteEmptyFolderOnly(oRootFDR) Then
oRootFDR.Delete
End If
Set oRootFDR = Nothing
Set oFSO = Nothing
End Sub
Private Function DeleteEmptyFolderOnly(ByRef oFDR As Object) As Boolean
Dim bDeleteFolder As Boolean, oSubFDR As Object
bDeleteFolder = False
' Recurse into SubFolders
For Each oSubFDR In oFDR.SubFolders
If DeleteEmptyFolderOnly(oSubFDR) Then
Debug.Print "Delete", oSubFDR.Path ' Comment for production use
oSubFDR.Delete
End If
Next
' Mark ok to delete when no files and subfolders
If oFDR.Files.Count = 0 And oFDR.SubFolders.Count = 0 Then
bDeleteFolder = True
End If
DeleteEmptyFolderOnly = bDeleteFolder
End Function
After the code executed, Folders remained are:
And the immediate window shows the folders that are deleted:
I would like to create a directory and a subdirectory with the following code:
Public fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
fso.CreateFolder ("C:\Users\<my_username>\DataEntry\logs")
I am trying to create nested directories. In this case, the DataEntry directory would not exist, so essentially I would like to create 2 directories, DataEntry\logs under C:\Users\<username>
If I enter command prompt, I can create that directory with mkdir without any issues. However, I simply cannot get VBA to create that folder and I get:
Run-time error '76':
Path not found
I am using Excel VBA 2007/2010
tigeravatar's looping answer might work, but it's a bit hard to read. Instead of micromanaging the string handling yourself, the FileSystemObject has path manipulation functions available, and recursion is slightly easier to read than a loop.
Here is the function I use:
Function CreateFolderRecursive(path As String) As Boolean
Dim FSO As New FileSystemObject
'If the path exists as a file, the function fails.
If FSO.FileExists(path) Then
CreateFolderRecursive = False
Exit Function
End If
'If the path already exists as a folder, don't do anything and return success.
If FSO.FolderExists(path) Then
CreateFolderRecursive = True
Exit Function
End If
'recursively create the parent folder, then if successful create the top folder.
If CreateFolderRecursive(FSO.GetParentFolderName(path)) Then
If FSO.CreateFolder(path) Is Nothing Then
CreateFolderRecursive = False
Else
CreateFolderRecursive = True
End If
Else
CreateFolderRecursive = False
End If
End Function
Need to create each folder one at a time. You can use code like this to do so:
Sub tgr()
Dim strFolderPath As String
Dim strBuildPath As String
Dim varFolder As Variant
strFolderPath = "C:\Users\<my_username>\DataEntry\logs"
If Right(strFolderPath, 1) = "\" Then strFolderPath = Left(strFolderPath, Len(strFolderPath) - 1)
For Each varFolder In Split(strFolderPath, "\")
If Len(strBuildPath) = 0 Then
strBuildPath = varFolder & "\"
Else
strBuildPath = strBuildPath & varFolder & "\"
End If
If Len(Dir(strBuildPath, vbDirectory)) = 0 Then MkDir strBuildPath
Next varFolder
'The full folder path has been created regardless of nested subdirectories
'Continue with your code here
End Sub
Agree with MarkD's suggestion to utilize recursion, it was the code I came here looking to find. In a scenario where the path provided uses a nonexistent root folder it will result in an infinite loop. Adding to MarkD's solution to check for zero length path.
Function CreateFolderRecursive(path As String) As Boolean
Static FSO As FileSystemObject
'Initialize FSO variable if not already setup
If FSO Is Nothing Then Set lFSO = New FileSystemObject
'Is the path paramater populated
If Len(path) = 0 Then
CreateFolderRecursive = False
Exit Function
End If
'If the path exists as a file, the function fails.
If FSO.FileExists(path) Then
CreateFolderRecursive = False
Exit Function
End If
'If the path already exists as a folder, don't do anything and return success.
If FSO.FolderExists(path) Then
CreateFolderRecursive = True
Exit Function
End If
'recursively create the parent folder, then if successful create the top folder.
If CreateFolderRecursive(FSO.GetParentFolderName(path)) Then
If FSO.CreateFolder(path) Is Nothing Then
CreateFolderRecursive = False
Else
CreateFolderRecursive = True
End If
Else
CreateFolderRecursive = False
End If
End Function
I have the file name with the entire path of the file except the file extension.
Example: "C:\temp\FileNameWithoutExtension". Now I want to check if this file exists? I don't care about the file extension.
When I have the entire file name including file extension I was using following code to see if the file exists.
Set oFSO = CreateObject("Scripting.FileSystemObject")
FileExists = oFSO.FileExists(FileName)
Thanks for help.
It would be nice if FileExists handled wildcards but it does not. Would something like this help?
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\temp")
Set objFiles = objFolder.Files
For Each objSingleFile in objFiles
If objSingleFile.Name Like "FileNameWithoutExtension*" Then
' The file name starts with FileNameWithoutExtension
MsgBox "Are you looking for me?: " & objSingleFile.Name
End If
Next
This is making assumption about the location you are searching and it is not recusrive but the basics are here for you to look at. This is not the only approach.
Try this
Sub FileExist()
Dim file As String, fileName As String
fileName = "C:\temp\abc" & "*"
file = Dir(fileName)
If file = "" Then
MsgBox "File doesn't exist"
Else
MsgBox "file found"
End If
End Sub
At present I am opening a file with my vbscript as follows:
strFile = "C:\Users\test\file.txt"
Set objFile = objFSO.OpenTextFile(strFile)
I would like to change this so that a file can be selected/navigated to by the user and that file is used in the script. How can I add this ability? I have tried to search for how to load a file dialog/prompt the user for a file etc just not sure how to complete in a VBScript.
There is another solution I found interesting from MS TechNet less customization but gets what you wanted to achieve. This returns the full path of the selected file.
Set wShell=CreateObject("WScript.Shell")
Set oExec=wShell.Exec("mshta.exe ""about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>""")
sFileSelected = oExec.StdOut.ReadLine
wscript.echo sFileSelected
Here you go:
http://www.robvanderwoude.com/vbstech_ui_fileopen.php
strFile = GetFileName("C:\Users\test\", "Text files|*.txt")
Set objFile = objFSO.OpenTextFile(strFile)
Function GetFileName( myDir, myFilter )
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objDialog
' Create a dialog object
Set objDialog = CreateObject( "UserAccounts.CommonDialog" )
' Check arguments and use defaults when necessary
If myDir = "" Then
' Default initial folder is "My Documents"
objDialog.InitialDir = CreateObject( "WScript.Shell" ).SpecialFolders( "MyDocuments" )
Else
' Use the specified initial folder
objDialog.InitialDir = myDir
End If
If myFilter = "" Then
' Default file filter is "All files"
objDialog.Filter = "All files|*.*"
Else
' Use the specified file filter
objDialog.Filter = myFilter
End If
' Open the dialog and return the selected file name
If objDialog.ShowOpen Then
GetFileName = objDialog.FileName
Else
GetFileName = ""
End If
End Function
The currently chosen answer doesn't support filters, but hta can be manipulated to support them.
Here's an answer based on this tek-tips.com post (which is also mentioned in
How to add filter to a file chooser in batch?), but I added a full function structure plus support for relative folders:
Function GetFileDlgEx(sIniDir,sFilter)
sTitle = "Choose File"
set objShell = WScript.CreateObject("WScript.Shell")
if instr(sIniDir, ":") <= 0 then
sIniDir = objShell.CurrentDirectory & "\" & sIniDir
end if
sIniDir = Replace(sIniDir,"\","\\")
Set oDlg = objShell.Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);eval(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0).Read("&Len(sIniDir)+Len(sFilter)+Len(sTitle)+41&"));function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg(iniDir,null,filter,title)));close();}</script><hta:application showintaskbar=no />""")
oDlg.StdIn.Write "var iniDir='" & sIniDir & "';var filter='" & sFilter & "';var title='" & sTitle & "';"
GetFileDlgEx = oDlg.StdOut.ReadAll
End Function
sIniDir = "*.*pdf" ' will look in current folder - note extension must be preceded by an asterisk *.
'sIniDir = "docs\*.*pdf" ' will look in a relative folder
'sIniDir = "C:\Windows\*.*pdf" ' will look in an absolute folder
sFilter = "Adobe pdf (*.pdf)|*.pdf|All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Image files (*.gif;*.png;*jpg;*.bmp)|*.gif;*.png;*jpg;*.bmp|Html files (*.htm;*.html;*.mht)|*.htm;*.html;*.mht|"
rep = GetFileDlgEx(sIniDir,sFilter)
MsgBox rep
VBSEdit program installs a COM library VBSEdit Toolkit, which allows Open File dialogs.
From VBSEdit help:
Dialog boxes
OpenFileDialog method
Prompt the user to open a file
toolkit.OpenFileDialog ([initialFolder,[filters,[multiselect,[title]]]])
'Opens a single file
Set toolkit = CreateObject("VbsEdit.Toolkit")
files=toolkit.OpenFileDialog("c:\scripts\","Text Files (*.txt)|*.txt",False,"Open a text file")
If UBound(files)>=0 Then
WScript.Echo files(0)
Else
Wscript.Quit
End If
'Opens multiple files
Set toolkit = CreateObject("VbsEdit.Toolkit")
files=toolkit.OpenFileDialog("c:\scripts\","Text Files (*.txt)|*.txt",True,"Open a text file")
If UBound(files)>=0 Then
For Each filepath In files
WScript.Echo filepath
Next
Else
Wscript.Quit
End If
SaveFileDialog method
Prompt the user to save a file
toolkit.SaveFileDialog ([initialFolder,[initialFilename,[filters,[title]]]])
Set toolkit = CreateObject("VbsEdit.Toolkit")
filepath = toolkit.SaveFileDialog("c:\scripts","test.txt","Text Files (*.txt)|*.txt")
If Not(IsNull(filepath)) Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(filepath,True)
objFile.WriteLine Date
objFile.Close
Else
Wscript.Quit
End If
SelectFolder method
Prompt the user to select a folder
toolkit.SelectFolder ([initialDir,[title]])
Set toolkit = CreateObject("VbsEdit.Toolkit")
myfolder=toolkit.SelectFolder("c:\scripts\","Please select a folder")
If Not(IsNull(myfolder)) Then
WScript.Echo myfolder
Else
Wscript.Quit
End If
…
(Actually, folder selection dialogs can be opened without VBSEdit toolkit, with BrowseForFolder method of Shell.Application object.)
Found this answer HERE
Set WshShell=CreateObject("Wscript.Shell")
WshShell.BrowseForFolder(0, "Please select the folder.", 1, "")
I have a vbs script which captures file information and then exports it to a csv file. I need to run the script on main drives such as C:\, E:\, I:\ and more, but each time I run for the main directory I get "Permission Denied" when I try to run it for a subfolder example C:\Program Files it works fine. I have tested this on different desktop machines and servers with full admin accounts and still get it.
What could be the issue with this code. test.vbs
Option Explicit
Dim objFS, objFld
Dim objArgs
Dim strFolder, strDestFile, blnRecursiveSearch
Dim strLines()
Dim i
Dim strCsv
i = 0
' 'Get the commandline parameters
' Set objArgs = WScript.Arguments
' strFolder = objArgs(0)
' strDestFile = objArgs(1)
' blnRecursiveSearch = objArgs(2)
'###################################
'MAKE SURE THESE VALUES ARE CORRECT
'###################################
strFolder = "C:\"
strDestFile = "C:\Output.csv"
blnRecursiveSearch = True
'Create the FileSystemObject
Set objFS=CreateObject("Scripting.FileSystemObject")
'Get the directory you are working in
Set objFld = objFS.GetFolder(strFolder)
'Now get the file details
GetFileDetails objFld, blnRecursiveSearch
'Write the csv file
Set strCsv = objFS.CreateTextFile(strDestFile, True)
strCsv.Write Join(strLines, vbCrLf)
'Close and cleanup objects
strCsv.Close
Set strCsv = Nothing
Set objFld = Nothing
Set strFolder = Nothing
Set objArgs = Nothing
Private Sub GetFileDetails(fold, blnRecursive)
Dim fld, fil
dim strLine(5)
If blnRecursive Then
'Work through all the folders and subfolders
For Each fld In fold.SubFolders
GetFileDetails fld, True
Next
End If
'Now work on the files
For Each fil in fold.Files
strLine(0) = fil.Path
strLine(1) = fil.Type
strLine(2) = fil.Size
strLine(3) = fil.DateCreated
strLine(4) = fil.DateLastModified
strLine(5) = fil.DateLastAccessed
Redim Preserve strLines(i)
strLines(i) = Join(strLine, ",")
i = i + 1
Next
end sub
Please advise and modify code if you know where the issue is.
If it's a permissions problem I would strongly recommend Process Monitor from Sysinternals to diagnose it. You should be able to watch the cscript process (or whatever is executing your script) and find out what kind of permission problem you're having.