I am using the below code to cycle through '.csv' files in a directory and move them to a new directory (strRootDir and strTargetDir are local variables that have been initiated):
Dim objFile As file
Dim objFSO As FileSystemObject: Set objFSO = New FileSystemObject
Dim objFolder As Folder: Set objFolder = objFSO.GetFolder(strRootDir)
For Each objFile In objFolder.Files
If InStr(1, objFile.Name, ".csv") Then
FileFolderExists strTargetDir, True
objFile.Move (strTargetDir)
End If
Next objFile
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
Where the method 'FileFolderExists' is defined as:
Public Sub FileFolderExists(strFullPath As String, bMkDir As Boolean)
Dim bExists As Boolean
If Not Dir(strFullPath, vbDirectory) = vbNullString Then bExists = True
If Not bExists And bMkDir Then MkDir strFullPath
End Sub
My question is that once this process has completed, if I try to delete the directory 'strTargetDir' I get an error message saying the folder is in use by another program.
How do I stop this from happening?
What you see is a Ghost File. The explorer has an uncanny habit of being stubborn :)
Here is another scenario which illustrates the "Ghost File"
Just issue a Dir command to remind explorer that the file no longer exists after you move the file and every thing will be ok :)
Ret = Dir(Path_And_FileName_Which_Was_Moved)
Also why use fso for moving files? Here is a one line command
Name "C:\Path1\File1.Ext" As "C:\Path2\File2.Ext"
This will also not leave a GHOST File
Related
I need to perform a certain task over some excel files located in subfolders (which are inside a folder). This task must exclude all those file's names that contain the letter "v".
I used file name length since the files I want to use have that length (file names with letter "V" have more than 28 characters). Here is my code.
Sub test()
Application.ScreenUpdating = False
Dim Fso As Object, objFolder As Object, objSubFolder As Object
Dim FromPath As String
Dim FileInFolder As Object
FromPath = "C:\Prueba"
Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(FromPath)
For Each objSubFolder In objFolder.Subfolders
Dim wbk As Workbook
Dim Filename As String, File As Variant
Path = objSubFolder.Path
Filename = Dir(Path & "\*.xlsx")
For Each File In objSubFolder.Files
If Len(Filename) = 28 Then
Do something
wbk.Close True
Filename = Dir
End If
Next File
Next objSubFolder
ActiveWorkbook.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
This code works OK until it reaches a file with "V". It just stuck in that file (do nothing, which is good) and then goes to the next subfolder, ignoring all the remaining excel files.
I need some advice on how to deal with this.
thx
I would like to create a new Workbook with the name 'Land-DE'. If the file already exists in the directory it must delete it automatically before creating a new one. I've tried using the following code but it is not working.
Sub createwb()
Workbooks.add
Dim FSO
Dim path As String
Set FSO = CreateObject("Scripting.FileSystemObject")
set path = "D:\Job\Land-DE.xlsx"
If FSO.FileExists(path) Then
FSO.DeleteFile path, True
else
ActiveWorkbook.SaveAs "D:\Job\Land-DE.xlsX"
End If
End Sub
Why must it be deleted before save? Would it be enough:
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "D:\Job\Land-DE.xlsx"
Application.DisplayAlerts = True
Have a look at the following. This will check if there is a file with the name defined in path and if so delete it before saving it again.
Sub Createwb()
Dim path As String
path = "D:\Job\Land-DE.xlsx"
If Dir(path) <> "" Then Kill path
ActiveWorkbook.SaveAs path
End Sub
Sub createwb()
Workbooks.Add
Dim FSO
Dim path As String
Set FSO = CreateObject("Scripting.FileSystemObject")
path = "D:\Job\Land-DE.xlsx"
If FSO.FileExists(path) Then
FSO.DeleteFile path, True
End If
ActiveWorkbook.SaveAs path
End Sub
Two things: Set is used for setting objects. The path there is just a string variable. Objects are a group of functions and variables, like that FSO object you create above it.
Next, you need to make sure you save after you delete it, and also that the last version of the save is not still open when you loop through again. If it is, you'll get permission denied for trying to save over a file that's currently open.
There are multiple problems with your code
set path = "D:\Job\Land-DE.xlsx" 'It is syntax error, you can only set object in VBA , string is not considered as object
FSO.DeleteFile path, True 'USE kill instead, better performance
ActiveWorkbook.SaveAs "D:\Job\Land-DE.xlsX" ' Do not user active keyword, always set the object
Here is the code :
Sub createwb()
Dim wbnew As Workbook
Set wbnew = Workbooks.Add
Dim path As String
path = "D:\Job\Land-DE.xlsx"
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(path) Then
On Error Resume Next
Workbooks("Land-DE").Close False ' Close the workbook if open
Kill path
wbnew.SaveAs path
Else
wbnew.SaveAs path
End If
End Sub
This is what I have so far, might be good might not haha!
I have been trying to save a word document to about 400+ folders without having to go through them all, can this be done through VB Macros? I got it working to just save it to the directory, but I cannot save it to all the Subfolders.
Dim FileSystem As Object
Dim HostFolder As String
Sub DoFolder(folder)
HostFolder = ("H:\test2")
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
Dim SubFolder
For Each SubFolder In folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In folder.Files
Set FileSystem = CreateObject("Scripting.FileSystemObject")
' Operate on each file
ActiveDocument.Save
Next
End Sub
I recommended reading: Chip Pearson -Recursion And The FileSystemObject
Make a recursive subroutine to iterate over all the subfolders (and their subfolders) in the root directory.
getAllSubfolderPaths: returns an array that lists all the sub folders in a folder.
Function getAllSubfolderPaths(FolderPath As String, Optional FSO As Object, Optional List As Object)
Dim fld As Object
If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.Filesystemobject")
Set List = CreateObject("SYstem.Collections.ArrayList")
End If
List.Add FolderPath
For Each fld In FSO.GetFolder(FolderPath).SubFolders
getAllSubfolderPaths fld.Path, FSO, List
Next
getAllSubfolderPaths = List.ToArray
End Function
Test
Sub Test()
Const RootFolder As String = "C:\Users\Owner\Pictures"
Const SourcePath As String = "C:\Users\Owner\Documents\Youcam"
Const SourceFileName As String = "Capture.PNG"
Dim fld As Variant, FolderArray As Variant
Dim Destination As String, Source As String
FolderArray = getAllSubfolderPaths(RootFolder)
For Each fld In FolderArray
Destination = fld & "\" & SourceFileName
Source = SourcePath & "\" & SourceFileName
'Delete old copy of file
If Destination <> Source And Len(Dir(Destination)) Then Kill Destination
VBA.FileCopy Source:=Source, Destination:=Destination
Next
End Sub
Gotta love auditing requirements... You're basically on the right path, but you really only need one FileSystemObject. About the only errors I see are that you need the .Path of the folder here...
For Each SubFolder In folder.SubFolders
DoFolder SubFolder.Path '<---Here.
Next
...and you don't need to loop through all the files here (you may be overthinking this one a bit):
For Each File In folder.Files
Set FileSystem = CreateObject("Scripting.FileSystemObject")
' Operate on each file
ActiveDocument.Save
Next
Also, I'd suggest using early binding instead of late binding (although the example below can easily be switched). I'd do something a bit more like this:
Private Sub SaveDocToAllSubfolders(targetPath As String, doc As Document, _
Optional root As Boolean = False)
With New Scripting.FileSystemObject
Dim current As Scripting.folder
Set current = .GetFolder(targetPath)
If Not root Then
doc.SaveAs .BuildPath(targetPath, doc.Name)
End If
Dim subDir As Scripting.folder
For Each subDir In current.SubFolders
SaveDocToAllSubfolders subDir.Path, doc
Next
End With
End Sub
The root flag is just whether or not to save a copy in the host folder. Call it like this:
SaveDocToAllSubfolders "H:\test2", ActiveDocument, True
can you help me?
i want a macro vba that search for a SPECIFIC subfolder for example (Xfolder) between all the folders and subfolders that exist and move their files.
P:\Desktop\Folder1\subfolder\SUBFOLDER1\Xfolder
I'm using the VBA Scripting Runtime objects
Set oSourceFolder = fso.GetFolder(source)
If Dir(destinationFolder, 16) = "" Then MkDir (destinationFolder)
For Each oFile In oFolder.Files
If Dir(destinationFolder,16) = "" Then
fso.MoveFile oFile.Path, destinationFolder
End If
Next oFile
fso.DeleteFolder oFolder.Path
Next oFolder
Here's a solution:
Dim fsoFileSystem As New FileSystemObject
Dim foFolder As Folder, foSubFolder As Folder
Dim fFile As File
Dim strStartFolder As String, strMoveFolder As String, strTargetFolder As String
strStartFolder = "\\A\B\C"
strMoveFolder = "SearchFolder"
strTargetFolder = "\\B\D\E"
Set foFolder = fsoFileSystem.GetFolder(strStartFolder)
For Each foSubFolder In foFolder.SubFolders
If foSubFolder.Name = strMoveFolder Then
For Each fFile In foSubFolder.Files
fsoFileSystem.MoveFile fFile, strTargetFolder & "\"
Next
End If
Next
strStartFolder is the folder to Screen for subfolders.
strMoveFolder is the name of the Folder to look for.
strTargetFolder is the Folder to where all the strMoveFolder's files shall be moved.
To found some folder use something like this
Sub findFolder()
Dim searchFolderName As String
searchFolderName = "somePath"
Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
doFolder FileSystem.getFolder(searchFolderName)
End Sub
Sub doFolder(Folder)
Dim subFolder
On Error Resume Next
For Each subFolder In Folder.subfolders
If Split(subFolder, "\")(UBound(Split(subFolder, "\"))) = "testFolder" Then
MsgBox "gotcha"
End
End If
doFolder subFolder
Next subFolder
End Sub
And then you can do whatever with that folder and its content. So with i little use of google (one maybe two words) you can achieve what you wana
How to list all the files which match a certain pattern inside a user specified directory? This should work recursively inside the sub folders of the selected directory. I also need a convenient way(like tree control) of listing them.
It appears that a couple answers talk about recursion, and one about regex. Here's some code that puts the two topics together. I grabbed the code from http://vba-tutorial.com
Sub FindPatternMatchedFiles()
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objRegExp As Object
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.pattern = ".*xlsx"
objRegExp.IgnoreCase = True
Dim colFiles As Collection
Set colFiles = New Collection
RecursiveFileSearch "C:\Path\To\Your\Directory", objRegExp, colFiles, objFSO
For Each f In colFiles
Debug.Print (f)
'Insert code here to do something with the matched files
Next
'Garbage Collection
Set objFSO = Nothing
Set objRegExp = Nothing
End Sub
Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
ByRef matchedFiles As Collection, ByRef objFSO As Object)
Dim objFolder As Object
Dim objFile As Object
Dim objSubFolders As Object
'Get the folder object associated with the target directory
Set objFolder = objFSO.GetFolder(targetFolder)
'Loop through the files current folder
For Each objFile In objFolder.files
If objRegExp.test(objFile) Then
matchedFiles.Add (objFile)
End If
Next
'Loop through the each of the sub folders recursively
Set objSubFolders = objFolder.Subfolders
For Each objSubfolder In objSubFolders
RecursiveFileSearch objSubfolder, objRegExp, matchedFiles, objFSO
Next
'Garbage Collection
Set objFolder = Nothing
Set objFile = Nothing
Set objSubFolders = Nothing
End Sub
As a general pointer, take a look at Application.FileSearch, recursive functions, Userforms and the 'Microsoft TreeView Control'.
FileSearch can be used to find files within a folder matching a pattern, a recursive function can call itself until all paths have been exhausted, a UserForm can host controls for displaying your data and the TreeView control can display your file system.
Bear in mind that there are pre-built functions/controls which can be used for displaying file systems, e.g. Application.GetOpenFileName, Application.GetSaveAsFileName, Microsoft WebBrowser (given a 'file://...' URL).
Try Windows Scripting - File System Objects. This COM object which can be created form vba has functions for listing directories etc.
You can find documentation on MSDN
Not exactly what you asked for, but I thought I would post this here as it is related.
This is modified from the code found at http://www.cpearson.com/excel/FOLDERTREEVIEW.ASPX
This requires the reference Microsoft Scripting Runtime.
Sub ListFilePaths()
Dim Path As String
Dim Files As Long
Path = "C:\Folder"
Files = GetFilePaths(Path, "A", 1)
MsgBox "Found " & Files - 1 & " Files"
End Sub
Function GetFilePaths(Path As String, Column As String, StartRow As Long) As Long
Dim Folder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim File As Scripting.File
Dim FSO As Scripting.FileSystemObject
Dim CurrentRow As Long
Set FSO = New Scripting.FileSystemObject
Set Folder = FSO.GetFolder(folderpath:=Path)
CurrentRow = StartRow
For Each File In Folder.Files
Range(Column & CurrentRow).Value = File.Path
CurrentRow = CurrentRow + 1
Next File
For Each SubFolder In Folder.SubFolders
CurrentRow = GetFilePaths(SubFolder.Path, Column, CurrentRow)
Next SubFolder
GetFilePaths = CurrentRow
Set Folder = Nothing
Set FSO = Nothing
End Function
I see that the people above me have already answered how to recurse through the file tree, This might interest you in searching for patterns in the file/file name. It is a Function for VBA that will allow regular expressions to be used.
Private Function RegularExpression(SearchString As String, Pattern As String) As String
Dim RE As Object, REMatches As Object
'Create the regex object'
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
'set the search pattern using parameter Pattern'
.Pattern = Pattern
End With
'Search for the pattern'
Set REMatches = RE.Execute(SearchString)
If REMatches.Count > 0 Then
'return the first match'
RegularExpression = REMatches(0)
Else
'nothing found, return empty string'
RegularExpression = ""
End If
End Function
You can use this to search the file names for patterns. I suggest regular expressions home for more information on how to use Regular expressions