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).
Related
I'm using these two functions to create project folders on startup. In the beginning I'm creating only one folder named ProjectName but now there's other folders on the same level with ProjectName named ProjectName_Inputs, ProjectName_Files, ProjectName_Outputs. I want to create them with my below code.
I wonder how can I adapt this to my code. I mean, is it possible to use an array or for loop etc.? path = [/ProjectName, ProjectName_Inputs, ProjectName_Files, ProjectName_Outputs] I don't know if it's possible?
Or can you suggest a more logical way to create them?
Sub CreateFolders()
Dim fso As New FileSystemObject
If Functions.FolderExists(path) Then
Exit Sub
Else
On Error GoTo FolderNotBuilt
fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
Exit Sub
End If
FolderNotBuilt:
MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
FolderCreate = False
Exit Sub
End Sub
This is the function that controls whether or not the directory created before
Function FolderExists(ByVal path As String) As Boolean
FolderExists = False
Dim fso As New FileSystemObject
If fso.FolderExists(path) Then FolderExists = True
End Function
Edited to amend a typo (End With missing) and change Resume to Resume Nextand skip the possibly screwed up path
I’d go like follows
Sub CreateFolders()
Dim path As Variant
With CreateObject("Scripting.FileSystemObject") 'create and reference a FileSystemObject object
For Each path In Array("path1*\", "path2", "path3")
If Not .FolderExists(path) Then 'loop through paths in array
On Error GoTo FolderNotBuilt
.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
End If
Next
End With
Exit Sub
FolderNotBuilt:
MsgBox "A folder could not be created for the following path: " & vbCrLf & vbCrLf & path & vbCrLf & "Check the path name and try again."
Resume Next
End Sub
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 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
I am trying to search through a directory for Shortcuts, get the path for the Shortcut, and add those paths to a collection, for later usage. However subsequent calls to Dir() returns the same file over and over again. I have isolated the problem to being caused by calling the Function Getlnkpath defined below. This function I haven't written myself, so I am unsure exactly what is causing this behaviour, or how to fix it.
tempPath = Dir(startPath & "*.lnk")
Do Until tempPath = vbNullString
myCollection.Add Getlnkpath(startPath & tempPath) & "\"
tempPath = Dir()
Loop
Function Getlnkpath(ByVal Lnk As String)
On Error Resume Next
With CreateObject("Wscript.Shell").CreateShortcut(Lnk)
Getlnkpath = .TargetPath
.Close
End With
End Function
It might be safer to
first: collect all links paths
then: collect all link target paths
so that the first collection stays stable whatever the subsequent operations may do (unless they delete some link or some folder...)
moreover I'd suggest to initialize one Wscript.Shell object only and handle all calls to its CreateShortcut() with it, instead of instantiating one object for each link
finally I myself am drifting towards the use of FileSystemObject in lieu of Dir() function, due to problems I sometimes meet with the latter. this at the only expense of adding the reference to Microsoft Scripting Runtime library
for what above I propose the following code:
Option Explicit
Sub main()
Dim startPath As String
Dim myLinkTargetPaths As New Collection, myLinkFilePaths As Collection
startPath = "C:\myPath\"
Set myLinkFilePaths = GetLinksPaths(startPath) 'first get the collection of all links path
Set myLinkTargetPaths = GetLinksTarget(myLinkFilePaths) ' then get the collection of all links TargetPaths
End Sub
Function GetLinksTarget(myLinkFilePaths As Collection) As Collection
Dim myColl As New Collection
Dim element As Variant
With CreateObject("Wscript.Shell")
For Each element In myLinkFilePaths
myColl.Add .CreateShortcut(element).TargetPath & "\"
Next element
End With
Set GetLinksTarget = myColl
End Function
Function GetLinksPaths(startPath As String) As Collection
Dim objFso As FileSystemObject '<~~ requires adding reference to `Microsoft Scripting Runtime` library
Dim objFile As File
Dim objFolder As Folder
Dim myColl As New Collection
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(startPath)
For Each objFile In objFolder.Files
If objFso.GetExtensionName(objFile.Path) = "lnk" Then myColl.Add objFile.Path
Next
Set GetLinksPaths = myColl
End Function
instead, should you want to go on with Dir() function then just change the GetLinksPaths() function as follows:
Function GetLinksPaths(startPath As String) As Collection
Dim tempPath As String
Dim myColl As New Collection
tempPath = Dir(startPath & "*.lnk")
Do Until tempPath = vbNullString
myColl.Add startPath & tempPath
tempPath = Dir()
Loop
Set GetLinksPaths = myColl
End Function
BTW: the CreateObject("Wscript.Shell").CreateShortcut(Lnk) method returns and object (either a WshShortcut or a WshURLShortcut one) that doesn't support any Close() method as you have in your Getlnkpath() function. So remove it to remove the necessity of On Error Resume Nextstatement
Looks like you are creating a new .lnk file with your function and your dir command finds that newly created link (that has overwritten the old one) next. Try to use GetShortcut instead of CreateShortcut in your function.
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