I try to get a directory which is in the network by using a UNC Path and the FileSystemObject, but if the network directory is not available the response takes so much time. I guess this is because of scanning the a lot of the network and or sends some more pings at this point.
So is there a method which I could use for check faster the exist of a network-directory before using the FSO?
I've added a file check (and an example of it being called from a subroutine), then a folder check. Both are called in the same way, and both utilise the Dir function. I added an error handler in the filecheck, it's worth adding this for the folder checker too:
Sub Main()
if FileExists("O:\Filenamehere") = TRUE then
'do stuff
end if
End Sub
'For a file
Function FileExists(ByVal FullPath As String) As Boolean
On Error GoTo Hand
If Dir(FullPath) <> "" Then
FileExists = True
Else
FileExists = False
End If
Exit Function
Hand:
Select Case Err.Number
Case 52
FileExists = False
End Select
End Function
'For a directory
Function DirectoryExists(ByVal FullPath As String) As Boolean
If Dir(FullPath, vbDirectory) <> "" Then DirectoryExists = True Else DirectoryExists = False
End Function
Related
I have problem. This is a code
Function FolderCreate(ByVal path As String) As Boolean
FolderCreate = True
Dim fso As New FileSystemObject
If FolderExist(path) Then
Exit Function
Else
fso.CreateFolder path
Exit Function
End If
End Function
Function FolderExist(ByVal path As String) As Boolean
FolderExist = False
Dim fso As New FileSystemObject
If fso.FolderExists(path) Then FolderExist = True
End Function
i try too create folder U:\Paweł\Generator\Akus Marcin 20180108001
and i get a bad file name or number.
when i try to create other folder like this U:\Paweł\Generator\Bedrunka Brunon 20171219001 there is no problem. What's wrong with the name of the folder?
thanks for the answer
Not an answer to the question, but possibly a solution to the problem, with code using MkDir that has been tested and acknowledged by others.
Function FolderCreate(ByVal path As String) As Boolean
'Dim strDir As String
'strDir = "C:\My Documents\TestDir\"
If Dir(path, vbDirectory) = "" Then
MkDir path
FolderCreate = True
Else
MsgBox "Directory exists."
FolderCreate = False
End If
End Function
From your code it is not clear if you want the assignments of the return value as I used, the opposite, or something else.
You may modify this.
Source: adapted from http://www.vbaexpress.com/forum/showthread.php?7866-Check-for-folder-create-if-it-does-not-exist
You may also try other tested code, or take snippets from there...
https://www.extendoffice.com/documents/excel/4182-excel-check-if-folder-exists.html
This worked with the folders I created. No references need to be set as it's using Late Binding.
Sub Test()
CreateFolder "U:\Pawel\Generator\Akus Marcin 20180108001"
CreateFolder "U:\Pawel\Generator\Bedrunka Brunon 20171219001"
End Sub
Sub CreateFolder(Folder As String)
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
With oFSO
If Not .FolderExists(Folder) Then
.CreateFolder Folder
End If
End With
End Sub
Edit: Testing with your code didn't return any errors either. If my code returns errors it may be a system setting that's stopping the folder being created (but that doesn't explain why one folder gets created while the other doesn't in the same parent folder).
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 have the below code to try search for all files in my downloads folder and then delete them all however it's returning an error message based on the kill function not having enough arguments, any ideas?
Sub Kill ()
Dim aFile As String
aFile = "C:\Test\Test\Downloads\*.*"
If Len(Dir$(aFile)) > 0 Then
Kill aFile
End If
End Sub
Thanks,
A more simple way:
Sub Del()
Kill "C:\FolderName\*.*"
End Sub
Add a reference to Microsoft Scripting Runtime in the VBA environment
The declare in a Module the following line
Global fso As New FileSystemObject
Now you can use all the nice and modern I/O functions. For example:
Public Sub TDELFOL()
Dim path As String, f As File
path = fso.GetSpecialFolder(TemporaryFolder)
path = fso.BuildPath(path, "MyTempFolder")
If fso.FolderExists(path) Then
For Each f In fso.GetFolder(path).Files
f.Delete Force = True
Next
fso.DeleteFolder path, Force = True
End If
End Sub
You should not name macros as the in built functions. Just changing the macros with the same coding resolves the issues...
Sub Kill1 ()
Dim aFile As String
aFile = "C:\Test\Test\Downloads\*.*"
If Len(Dir$(aFile)) > 0 Then
Kill aFile
End If
End Sub
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 mapped an intranet location using the File Explorer. i.e. mapped http://intranet.XXXXXXX.com/mydir/ to M:\
I'm using the Dir function to test if a file is present in that location:
Dim FileExists as Boolean
FileExists = Dir("M:\myfile") <> ""
If FileExists Then MsgBox "File found in M:"
I run that macro on Excel 2007 and it Works Fine. When I run it on Excel 2010 though, Dir("M:\myfile") always returns "", even if the file is present in the specified location. I can´t find a solution that will work on both Excel versions. Any ideas?
You may add file extension as a wildcard character at the end of filepath. I gave a try in excel 2010 and it worked for me.
Dim FileExists As Boolean
FileExists = Dir("D:\myfile" & "*.txt") <> ""
If FileExists Then MsgBox "File found in M:"
I found that if I use the full network name, it works first go. This wasn't just in VBA, but also some shortcuts also - they returned "File could not be found".
Changing from the mapped shortcut, e.g.
Y:\Projects\Proj1\File1.xlsx
to the full mapped path, e.g.
\\server\Department\Projects\Proj1\File1.xlsx
Fixed the problem
Here is how to use FSO to do what you want:
Option Explicit
Function test_it()
'Test the Function - must pass the file path and name
Debug.Print Does_File_Exist("C:\temp\form1.txt")
End Function
Private Function Does_File_Exist(sFullPath) As Boolean
' Will return True or False if file exists.
' Provide the fully qualified path and file name.
' You can disable the MsgBox displays after testing
Dim oFs As New FileSystemObject
Dim oFile As File
Set oFs = New FileSystemObject
If oFs.FileExists(sFullPath) Then
Does_File_Exist = True
MsgBox "Found file: " & sFullPath
Else
Does_File_Exist = False
MsgBox "File not found: " & sFullPath
End If
Set oFs = Nothing
End Function