I would like to know if somebody knows which function is the fastest way to delete a folder and all its files and subdirectories.
I know (fastest one so far):
Dim SHFileOp As SHFILEOPSTRUCT
With SHFileOp
' Function: Delete
.wFunc = FO_DELETE
' Which file/dir
.pFrom = uFolder
' Set flags
.fFlags = FOF_SILENT Or _
FOF_SIMPLEPROGRESS Or _
FOF_NOCONFIRMATION
End With
' Kiss it goodbye
SHFileOperation SHFileOp
and (much slower):
Dim fso
Dim fs
Set fso = CreateObject("Scripting.FileSystemObject")
fs = fso.DeleteFolder(uFolder, True)
Does anybody know a function that is even faster than the first?
If it's the actual delete process that is tying up your active thread then you could try multi-threading the process.
Retain your fastest method above but get it to run in a parallel thread.
Related
My goal is to read the FileNames of all png files in a given folder.
I've Windows VBA code which uses the ActiveX FileSystemObject.
On a MAC This code results in
"runtime error 429 activex component can't create object"
Function ReadFileNames(ByVal sPath As String) As Integer
Dim oFSO, oFolder, oFile As Object
Dim sFileName As String
Set oFSO = CreateObject("scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sPath)
For Each oFile In oFolder.Files
If Not oFile Is Nothing And Right(LCase(oFile.Name), 4) = ".png" Then ' read only PNG-Files
sFileName = oFile.Name
' do something with the FileName ...
End If
Next oFile
End Function
Here is a sub, using the native VBA DIR command, listing EXCEL workbooks in a folder by printing their names on the debug window:
Public Sub DirXlList()
Const cstrPath As String = "c:\users\xxxx\misc\"
Dim strDirItem As String
strDirItem = Dir(cstrPath & "*.xlsx")
While strDirItem <> ""
Debug.Print "FileName: " & strDirItem, "FullPath: " & cstrPath & strDirItem
strDirItem = Dir()
DoEvents
Wend
End Sub
Does this help? In
Update: doevents command allows Excel to process other pending user interface activities, such as window refreshes, mouse-clicks. If you have lots of files (thousands) in a folder, Excel may appear unresponsive/frozen in a loop like this. It is not necessary, as it will become responsive again, once it completes the loop. If you have only a few hundred files then it is an overkill. Remove and try.
VBA for Mac can link to the entire c standard library, like this example:
Private Declare PtrSafe Function CopyMemory_byPtr Lib "libc.dylib" Alias "memmove" (ByVal dest As LongPtr, ByVal src As LongPtr, ByVal size As Long) As LongPtr
I'm too lazy to write out relevant examples for you, but if, by chance, you are familiar with using the c standard library for file manipulation, you can just do it that way.
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.
This seems so simple and I've had it working multiple times, but something keeps breaking between my Dir call (to iterate through a directory) and opening the current file. Here's the pertinent code:
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceCurrentFile)
What I get with this is a file access error as the Application.Workbooks.Open is trying to open "C:\ExcelWIP\TestSource\\FILENAME" (note extra slash)
However when I take the final slash out of SourceLoc, the results of Dir(SourceLoc) are "" (it doesn't search the directory).
The frustrating thing is that as I've edited the sub in other ways, the functionality of this code has come and gone. I've had it work as-is, and I've had taking the '/' out of the directory path make it work, and at the moment, I just can't get these to work right together.
I've scoured online help and ms articles but nothing seems to point to a reason why this would keep going up and down (without being edited except for when it stops working) and why the format of the directory path will sometimes work with the final '/' and sometimes without.
any ideas?
This would open all .xlxs files in that directory son.
Sub OpenFiles()
Dim SourceCurrentFile As String
Dim FileExtension as String: FileExtension = "*.xlxs"
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
SourceCurrentFile = Dir()
'Start looping through directory
Do While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc &"\"& SourceCurrentFile)
SourceCurrentFile = Dir(FileExtension)
Loop
End Sub
JLILI Aman hit on the answer which was to take the results of Dir() as a string. Using that combined with the path on Application.Open allows for stable behaviors from the code.
New Code:
Dim SourceLoc as String
Dim SourceCurrentFile as String
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc & "/" & SourceCurrentFile)
I didn't include the recommended file extension because I'm dealing with xls, xlsx, and xlsm files all in one directory. This code opens all of them.
Warning - this code will set current file to each file in the directory including non-excel files. In my case, I'm only dealing with excel files so that's not a problem.
As to why this happens, it does not appear that Application.Open will accept the full object results of Dir(), so the return of Dir() needs to be a String. I didn't dig deeper into the why of it beyond that.
Consider using VBA's FileSystemObject which includes the folder and file property:
Sub xlFilesOpen()
Dim strPath As String
Dim objFSO As Object, objFolder As Object, xlFile As Object
strPath = "C:\ExcelWIP\TestSource"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)
For Each xlFile In objFolder.Files
If Right(xlFile, 4) = "xlsx" Or Right(xlFile, 3) = "xls" Then
Application.Workbooks.Open (xlFile)
End If
Next xlFile
Set objFSO = Nothing
Set objFolder = Nothing
End Sub
i currently have this code in one of the macros for work. It is located under a button for browsing which folder to look into, and it will get the .DGNs and add them to a listbox.
I don't quite understand the code fully was hoping someone can give me a quick run down. Also, the code only looks at the selected folder for .DGNs, i want it to look into sub folders as well, is that possible?
Dim myFSO As New Scripting.FileSystemObject
Dim myFolder As Scripting.Folder
Dim myFile As Scripting.File
Dim myShell As New Shell32.Shell
Dim myRootFolder As Shell32.Folder3
Set myRootFolder = myShell.BrowseForFolder(0, "Pick", 0)
If myRootFolder Is Nothing Then Exit Sub
Set myFolder = myFSO.GetFolder(myRootFolder.Self.path)
txtCurrentFolder.Text = myRootFolder.Self.path
lstFilesInFolder.Clear
For Each myFile In myFolder.Files
Select Case UCase(Right(myFile.Name, 3))
Case "DGN"
If IsFileIn(myFile.path, lstFilesToProcess) = False Then
lstFilesInFolder.AddItem myFile.path
End If
End Select
Next
The code shows a GUI to select a folder, then iterates through the folder's child files testing if their names end in DGN and if so then testing if the file is already in some collection (lstFilesInFolder) and if not then adding it.
I think the approach seems a little complicated (picking a folder(s) can be done simply without using the Shell through Application.FileDialog) and I cannot judge some parts (like is it necessary to test lstFilesInFolder etc) without the rest of the code, and just personally I dislike the use of myX as a variable naming convention. Nevertheless, it does what it seems it is meant to do.
I like a stack/queue based approach to 'recursion' rather than actual recursive calls.
An example of converting your code to something that looks in subfolders as well is: (see comments on my added lines)
Dim myFSO As Scripting.FileSystemObject 'changed from late-binding
Set myFSO = New Scripting.FileSystemObject
Dim folderQueue As Collection 'queue
Set folderQueue = New Collection 'instantiate
Dim myFolder As Scripting.Folder
Dim subfolder As Scripting.Folder 'var for enumerating subfolders
Dim myFile As Scripting.File
Dim myShell As New Shell32.Shell
Dim myRootFolder As Shell32.Folder3
Set myRootFolder = myShell.BrowseForFolder(0, "Pick", 0)
If myRootFolder Is Nothing Then Exit Sub
folderQueue.Add myFSO.GetFolder(myRootFolder.Self.path) 'enqueue
Do While folderQueue.Count > 0 ''recursive' loop
Set myFolder = folderQueue(1) 'get next folder
folderQueue.Remove 1 'dequeue
txtCurrentFolder.Text = myRootFolder.Self.path
lstFilesInFolder.Clear
For Each subfolder in myFolder.SubFolders 'loop through subfolders adding for processing
folderQueue.Add subfolder 'enqueue
Next
For Each myFile In myFolder.Files
Select Case UCase(Right(myFile.Name, 3))
Case "DGN"
If IsFileIn(myFile.path, lstFilesToProcess) = False Then
lstFilesInFolder.AddItem myFile.path
End If
End Select
Next
Loop
As a final point, it is sometimes considered good practice to switch the use of a reference to a specific version of the Scripting library (nice for static typing) to using e.g. CreateObject("Scripting.FileSystemObject") before releasing to other users as the use of a reference can sometimes cause issues.
I have a file which is manually added or modified based on the inputs. Since most of the contents are repetitive in that file, only the hex values are changing, I want to make it a tool generated file.
I want to write the c codes which are going to be printed in that .txt file.
What is the command to create a .txt file using VBA, and how do I write to it
Use FSO to create the file and write to it.
Dim fso as Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile as Object
Set oFile = FSO.CreateTextFile(strPath)
oFile.WriteLine "test"
oFile.Close
Set fso = Nothing
Set oFile = Nothing
See the documentation here:
http://technet.microsoft.com/en-us/library/ee198742.aspx
http://technet.microsoft.com/en-us/library/ee198716.aspx
Open ThisWorkbook.Path & "\template.txt" For Output As #1
Print #1, strContent
Close #1
More Information:
Microsoft Docs : Open statement
Microsoft Docs : Print # statement
Microsoft Docs : Close statement
wellsr.com : VBA write to text file with Print Statement
Office Support : Workbook.Path property
To elaborate on Ben's answer:
If you add a reference to Microsoft Scripting Runtime and correctly type the variable fso you can take advantage of autocompletion (Intellisense) and discover the other great features of FileSystemObject.
Here is a complete example module:
Option Explicit
' Go to Tools -> References... and check "Microsoft Scripting Runtime" to be able to use
' the FileSystemObject which has many useful features for handling files and folders
Public Sub SaveTextToFile()
Dim filePath As String
filePath = "C:\temp\MyTestFile.txt"
' The advantage of correctly typing fso as FileSystemObject is to make autocompletion
' (Intellisense) work, which helps you avoid typos and lets you discover other useful
' methods of the FileSystemObject
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim fileStream As TextStream
' Here the actual file is created and opened for write access
Set fileStream = fso.CreateTextFile(filePath)
' Write something to the file
fileStream.WriteLine "something"
' Close it, so it is not locked anymore
fileStream.Close
' Here is another great method of the FileSystemObject that checks if a file exists
If fso.FileExists(filePath) Then
MsgBox "Yay! The file was created! :D"
End If
' Explicitly setting objects to Nothing should not be necessary in most cases, but if
' you're writing macros for Microsoft Access, you may want to uncomment the following
' two lines (see https://stackoverflow.com/a/517202/2822719 for details):
'Set fileStream = Nothing
'Set fso = Nothing
End Sub
an easy way with out much redundancy.
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Fileout As Object
Set Fileout = fso.CreateTextFile("C:\your_path\vba.txt", True, True)
Fileout.Write "your string goes here"
Fileout.Close
Dim SaveVar As Object
Sub Main()
Console.WriteLine("Enter Text")
Console.WriteLine("")
SaveVar = Console.ReadLine
My.Computer.FileSystem.WriteAllText("N:\A-Level Computing\2017!\PPE\SaveFile\SaveData.txt", "Text: " & SaveVar & ", ", True)
Console.WriteLine("")
Console.WriteLine("File Saved")
Console.WriteLine("")
Console.WriteLine(My.Computer.FileSystem.ReadAllText("N:\A-Level Computing\2017!\PPE\SaveFile\SaveData.txt"))
Console.ReadLine()
End Sub()