What do you mean by this?Quote:
If all you want to do is keep a 'running list' of PATHs that have passed, a simple .RemoveDuplicates() would work
Printable View
What do you mean by this?Quote:
If all you want to do is keep a 'running list' of PATHs that have passed, a simple .RemoveDuplicates() would work
I was just wondering why do you have a second module with this code:
when you have :Code:Option Explicit
Sub Macro1()
'
' Macro1 Macro
'
'
ActiveSheet.Range("$A$1:$H$104").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
Sub Macro2()
'
' Macro2 Macro
'
'
End Sub
and also from here:Code:Private Sub RemoveDups() wsOut.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
which already removes duplicates as intendedCode:Call GetFiles(oFSO.GetFolder(RemovePrefix(sPathTop)))
wsOut.Cells(rowStart, colFileFolder).Value = "Parent Folder"
RemoveDups
Cleanup
Also, i have tested out a parent folder path which is 243 characters long and the files within it did not get listed even thought I have attached a " \\?\ " prefix to take care of long file names...
1. I recorded Macro1() just to get an idea of the syntax to incorporate and forgot to delete it. You can delete it
2. I didn't make any extra long folders. Try removing the RemovePrefix logic and see if that works
Did some experimenting and the results were confusing. I'm not too sure the FSO treats "\\?" consistently
Try this and see if you can get rid of using the "\\?"
https://www.itprotoday.com/windows-1...ort-windows-10
Quote:
Q. How do I enable long file name support in Windows 10?A. In the past the maximum supported file length was 260 characters (256 usable after the drive characters and termination character). In Windows 10 long file name support can be enabled which allows file names up to 32,767 characters (although you lose a few characters for mandatory characters that are part of the name). To enable this perform the following:
- Start the registry editor (regedit.exe)
- Navigate to HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem
- Double click LongPathsEnabled
- Set to 1 and click OK
- Reboot
This can also be enabled via Group Policy via Computer Configuration > Administrative Templates > System > Filesystem > Enable NTFS long paths.
oh...ive done that already and its enabled. When I disabledand ran my code on the long folder path I got a run-time error '76': path not found...Quote:
ActiveSheet.Range("$A$1:$H$104").RemoveDuplicates Columns:=1, Header:=xlYes
Any cause for the error in the previous post?
Couldn't tell you. My macro doesn't generate any errors:
Code:Private Sub RemoveDups() wsOut.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
But I explicitly specify the worksheet (wsOut and not ActiveSheet) and explicitly use the entire CurrentRegion (and not hardcoded A1:H104)
If I had to guess, I'd suspect that the currently active worksheet is not the one with the file data
This is in response to the previous post. I am attaching 2 workbook so you can take a closer look at the errors
Afraid I'm not seeing the errors when I test using my shorter folder trees
I'm not sure what would caused the CountIf 1004 error. A manual WS formula works fine
Your top path is 290 characters and I tried to copy it, but bumped up against the limit and I didn't want to change my PC configuration to try and go longer
and there seems to be a lot of redundancy and very long folder names
Could you get it to something shorter?
The previous versions of excludes seemed to work perfectly fine and it was showing up very long folder paths without errors. I dont' know why but just yesterday I was having problems listing long folder paths, it didn't have this kind of error before...
may i ask please not to show the full folder path, I just didn't want to show my name...let me change the names out and put something random
Would it be possible just to enable long folder paths in your registry just for this problem?
OK ...
Note that my top path is on D: so change it to C: if necessary
Code:Option Explicit
Const sPathTop As String = "\\?\D:\test one"
Const colPath As Long = 1
Const colParent As Long = 2
Const colName As Long = 3
Const colFileFolder As Long = 4
Const colCreated As Long = 5
Const colModified As Long = 6
Const colSize As Long = 7
Const colType As Long = 8
Dim aryExclude As Variant
Dim rowOut As Long
Dim oFSO As Object
Dim wsOut As Worksheet
Dim rPrev As Range
Sub Start()
Dim rowStart As Long
Dim oFile As Object
' aryExclude = Array("\\?\C:\test\subfolder 1", "\\?\C:\test\subfolder 2", "\\?\C:\test\subfolder 3")
aryExclude = Array("")
Init
rowStart = rowOut
Call GetFiles(oFSO.GetFolder(sPathTop))
wsOut.Cells(rowStart, colFileFolder).Value = "Parent Folder"
RemoveDups
Cleanup
End Sub
Sub GetFiles(oPath As Object)
Dim oFolder As Object, oSubFolder As Object, oFile As Object
If IsExcluded(oPath) Then Exit Sub ' stops recursion
Call ListInfo(oPath, "Subfolder")
For Each oFile In oPath.Files
Call ListInfo(oFile, "File")
Next
For Each oSubFolder In oPath.SubFolders
Call GetFiles(oSubFolder)
Next
End Sub
'============================================================================
Private Sub Init()
Dim i As Long
Application.ScreenUpdating = False
If IsArray(aryExclude) Then
For i = LBound(aryExclude) To UBound(aryExclude)
aryExclude(i) = CStr(aryExclude(i))
Next i
End If
Set wsOut = Worksheets("Files")
With wsOut
'get last used row, or 1 if empty
rowOut = .Cells(.Rows.Count, 1).End(xlUp).Row
If rowOut = 1 Then ' blank sheet
.Cells(rowOut, colPath).Value = "FILE/FOLDER PATH"
.Cells(rowOut, colParent).Value = "PARENT FOLDER"
.Cells(rowOut, colName).Value = "FILE/FOLDER NAME"
.Cells(rowOut, colFileFolder).Value = "FILE or FOLDER"
.Cells(rowOut, colCreated).Value = "DATE CREATED"
.Cells(rowOut, colModified).Value = "DATE MODIFIED"
.Cells(rowOut, colSize).Value = "SIZE"
.Cells(rowOut, colType).Value = "TYPE"
End If
rowOut = rowOut + 1
'save the previous data
Set rPrev = wsOut.Cells(1, 1).CurrentRegion
End With
Set oFSO = CreateObject("Scripting.FileSystemObject")
End Sub
Private Sub Cleanup()
wsOut.Columns(colName).HorizontalAlignment = xlLeft
wsOut.Columns(colCreated).NumberFormat = "m/dd/yyyy"
wsOut.Columns(colModified).NumberFormat = "m/dd/yyyy"
wsOut.Columns(colSize).NumberFormat = "#,##0,.0 ""KB"""
wsOut.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Private Sub RemoveDups()
wsOut.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
' IFolder object
' Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive,
' Files, IsRootFolder, Name, ParentFolder (IFolder), Path,
' ShortName, ShortPath, Size, SubFolders, Type
' iFile object
' Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive (IDrive),
' Name, ParentFolder (IFolder), Path, ShortName, ShortPath, Size, Type
' Attributes
Private Sub ListInfo(oFolderFile As Object, sType As String)
With oFolderFile
wsOut.Cells(rowOut, colPath).Value = .Path
wsOut.Cells(rowOut, colParent).Value = oFSO.GetParentFolderName(.Path) ' <<<<<<<<<<
wsOut.Cells(rowOut, colName).Value = .Name
wsOut.Cells(rowOut, colFileFolder).Value = sType
wsOut.Cells(rowOut, colCreated).Value = .DateCreated
wsOut.Cells(rowOut, colModified).Value = .DateLastModified
wsOut.Cells(rowOut, colSize).Value = .Size
wsOut.Cells(rowOut, colType).Value = .Type
End With
rowOut = rowOut + 1
End Sub
Private Function IsExcluded(p As Object) As Boolean
Dim i As Long
If IsEmpty(aryExclude) Then
IsExcluded = False
Exit Function
End If
IsExcluded = True
For i = LBound(aryExclude) To UBound(aryExclude)
If UCase(p.Path) = UCase(aryExclude(i)) Then Exit Function ' <<<<<<<
Next i
IsExcluded = False
End Function
I want to extend my code to have a parent folder list in column J and an exclude list in column K. The below code is in module 2. I found that instead of writing each parent folder in "sPathTop", I could've listed the parent folders in column J (or any other column) and then ran the main code. I just don't know how to run the main code for each parent folder in column J while taking into account the exclude list in column K. In other words, how can I include the below code to run with my main code? Thanks
Code:Sub examplearray()
Dim testarray() As String, size As Integer, i As Integer, x As Variant
size = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
ReDim testarray(size)
'Range("L2") = LBound(testarray)
'Range("L3") = UBound(testarray)
For i = 1 To size
testarray(i) = Range("A" & i).Value
Next i
End Sub
It seems like there is a number of changes in the current version of excludes_14 from previous versions:
These have been removed, from comparing the older versions of exclude_#.xlsx with excludes_14.xlsx
1.has been removedCode:Dim numRuns As Long
2.has been removedCode:'see how many runs were packed in by counting "Parent Folder"
numRuns = Application.WorksheetFunction.CountIf(wsOut.Columns(colFileFolder), "Parent Folder")
3.has been removedCode:If numRuns > 0 Then RemoveDups
4.has been changed to:Code:Private Sub RemoveDups()
Dim rowNew As Long
For rowNew = wsOut.Cells(1, 1).CurrentRegion.Rows.Count To rPrev.Rows.Count + 1 Step -1
If Application.WorksheetFunction.CountIf(rPrev.Columns(colParent), wsOut.Cells(rowNew, colParent).Value) > 0 Then
'mark special
wsOut.Cells(rowNew, colParent).Value = True
End If
Next rowNew
On Error Resume Next
wsOut.Columns(colParent).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
On Error GoTo 0
End Sub
Does this new code do exactly the above code and only keeps 1 type of entry and removes all other duplicates from column 1?Code:Private Sub RemoveDups()
wsOut.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
Also,has been modified toCode:wsOut.Cells(rowOut, colParent).Value = RemovePrefix(.ParentFolder.path)
isnt .ParentFolder.path the same thing as oFSO.GetParentFolderName(.Path) ??Code:wsOut.Cells(rowOut, colParent).Value = oFSO.GetParentFolderName(.Path)
has been removed.. Why is this so?Code:Private Function RemovePrefix(s As String) As String
If Len(s) < 5 Then
RemovePrefix = s
Else
RemovePrefix = IIf(Left(s, 4) = "\\?\", Right(s, Len(s) - 4), s)
End If
End Function
has been changed to:Code:For i = LBound(aryExclude) To UBound(aryExclude)
aryExclude(i) = RemovePrefix(CStr(aryExclude(i)))
Next i
This only removes the long folder path prefix from the exclude list and not the parent folder column (2). It was done before in previous workbooks but not the new excludes_14...Code:For i = LBound(aryExclude) To UBound(aryExclude)
aryExclude(i) = CStr(aryExclude(i))
Next i
How come:generates error message saying "Run time error '76': Path not found" for the same parent folder even if its a longer folder path exceeding 260 characters??Code:Call GetFiles(oFSO.GetFolder(RemovePrefix(sPathTop)))
looking back at excludes_5,
I had a code which highlights duplicates in red colour using the below code:
module 2 code:
For a path that is for example, 52 characters long the above code highlights duplicates in column 1. But, I have a path that is 611 characters long, and for some reason it does not detect duplicates OR highlights them, instead returns an error message:Code:Option Explicit
Sub sbFindDuplicatesInColumn_C()
Dim i As Long
'Declaring the lastRow variable as Long to store the last row value in the Column1
Dim lastRow As Long
'matchFoundIndex is to store the match index values of the given value
Dim matchFoundIndex As Long
'iCntr is to loop through all the records in the column 1 using For loop
Dim iCntr As Long
'Finding the last row in the Column 1
lastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Range("A65000").End(xlUp).Row
'looping through the column1
For iCntr = 1 To lastRow
'checking if the cell is having any item, skipping if it is blank.
If Cells(iCntr, 1) <> "" Then
'getting match index number for the value of the cell
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
'if the match index is not equals to current row number, then it is a duplicate value
If iCntr <> matchFoundIndex Then
'Printing the label in the column B
Cells(iCntr, 1).Interior.Color = RGB(255, 12, 0)
Cells(iCntr, 2) = "there are duplicates here!"
End If
End If
Next
End Sub
run-time error 13: type mismatch, when I click debug it highlights "matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)" in module 2
Main code in module 1:
I am not understanding why it would not highlight because i can list the folders with long folder path recursively without errors and I would think that highlighting doesn't depend on the number of characters in a string...what is the solution to this?Code:Option Explicit
'>>>> this is for a path that is 52 characters long, including the long folder path prefix in the beginning
'>>>> duplicates are detected for this path (in column 1) and removed properly
'Const sPathTop As String = "\\?\C:\Users\abcde\Downloads\downloads abc 123 docs"
'>>>> this is for a path that is 611 characters long, including the long folder path prefix in the beginning
'>>>> duplicates are NOT detected for this path (in column 1) and gives run-time error 13: type mismatch, highlighting "highlighting matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)" in module 2
Const sPathTop As Variant = "\\?\C:\Users\nrhfy\Downloads\seagate 500\Documents and Settings\abcd\AppData\Local\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Adobe\Acrobat\11.0"
Const colPath As Long = 1
Const colParent As Long = 2
Const colName As Long = 3
Const colFileFolder As Long = 4
Const colCreated As Long = 5
Const colModified As Long = 6
Const colSize As Long = 7
Const colType As Long = 8
Dim aryExclude As Variant
Dim rowOut As Long
Dim oFSO As Object
Dim wsOut As Worksheet
Dim sParentFolder As Variant
Sub Start()
Dim rowStart As Long
aryExclude = Array("")
Init
rowStart = rowOut
sParentFolder = RemovePrefix(sPathTop)
Call GetFiles(oFSO.GetFolder(sPathTop))
wsOut.Cells(rowStart, colFileFolder).Value = "Parent Folder"
'wsOut.Columns(5).NumberFormat = "m/dd/yyyy"
'wsOut.Columns(6).NumberFormat = "m/dd/yyyy"
'wsOut.Columns(7).NumberFormat = "#,##0,.0 ""KB"""
End Sub
Sub GetFiles(oPath As Object)
Dim oFolder As Object, oSubFolder As Object, oFile As Object
If IsExcluded(oPath) Then Exit Sub ' stops recursion
sParentFolder = IIf(Left(oPath.path, 4) = "\\?\", Right(oPath.path, Len(oPath.path) - 4), oPath.path)
Call ListInfo(oPath, "Subfolder")
For Each oFile In oPath.Files
Call ListInfo(oFile, "File")
Next
For Each oSubFolder In oPath.SubFolders
Call GetFiles(oSubFolder)
Next
End Sub
'============================================================================
Private Sub Init()
Set wsOut = Worksheets("Sheet2")
With wsOut
rowOut = .Cells(.Rows.Count, 1).End(xlUp).Row
If rowOut = 1 Then ' blank sheet
.Cells(rowOut, 1).Value = "FILE/FOLDER PATH"
.Cells(rowOut, 2).Value = "PARENT FOLDER"
.Cells(rowOut, 3).Value = "FILE/FOLDER NAME"
.Cells(rowOut, 4).Value = "FILE or FOLDER"
.Cells(rowOut, 5).Value = "DATE CREATED"
.Cells(rowOut, 6).Value = "DATE MODIFIED"
.Cells(rowOut, 7).Value = "SIZE"
.Cells(rowOut, 8).Value = "TYPE"
End If
rowOut = rowOut + 1
End With
Set oFSO = CreateObject("Scripting.FileSystemObject")
End Sub
' IFolder object
' Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive,
' Files, IsRootFolder, Name, ParentFolder (IFolder), Path,
' ShortName, ShortPath, Size, SubFolders, Type
' iFile object
' Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive (IDrive),
' Name, ParentFolder (IFolder), Path, ShortName, ShortPath, Size, Type
' Attributes
Private Sub ListInfo(oFolderFile As Object, sType As String)
With oFolderFile
wsOut.Cells(rowOut, colPath).Value = RemovePrefix(.path)
wsOut.Cells(rowOut, colParent).Value = RemovePrefix(Left(.path, Len(.path) - Len(.Name) - 1))
wsOut.Cells(rowOut, colName).Value = .Name
wsOut.Cells(rowOut, colFileFolder).Value = sType
wsOut.Cells(rowOut, colCreated).Value = .DateCreated
wsOut.Cells(rowOut, colModified).Value = .DateLastModified
wsOut.Cells(rowOut, colSize).Value = .Size
wsOut.Cells(rowOut, colType).Value = .Type
End With
rowOut = rowOut + 1
End Sub
Private Function IsExcluded(p As Object) As Boolean
Dim i As Long
IsExcluded = True
For i = LBound(aryExclude) To UBound(aryExclude)
If UCase(p.path) = UCase(aryExclude(i)) Then Exit Function
Next i
IsExcluded = False
End Function
Private Function RemovePrefix(s As String) As String
If Len(s) < 5 Then
RemovePrefix = s
Else
RemovePrefix = IIf(Left(s, 4) = "\\?\", Right(s, Len(s) - 4), s)
End If
End Function
Quote:
For a path that is for example, 52 characters long the above code highlights duplicates in column 1. But, I have a path that is 611 characters long, and for some reason it does not detect duplicates OR highlights them, instead returns an error message:
run-time error 13: type mismatch, when I click debug it highlights "matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)" in module 2
https://exceljet.net/formula/match-l...compare%20text.
[QUOTE]
The MATCH function has a limit of 255 characters for the lookup value. If you try to use longer text, MATCH will return a #VALUE error. To workaround this limit you can use boolean logic and the LEFT, MID, and EXACT functions to parse and compare text./QUOTE]
You could generate a hash code for each entry and MATCH() against those
What does this mean?Quote:
You could generate a hash code for each entry and MATCH() against those
LMGTFY
https://en.wikipedia.org/wiki/Hash_function
Quote:
A hash function is any function that can be used to map data of arbitrary size to fixed-size values. The values returned by a hash function are called hash values, hash codes, digests, or simply hashes. The values are usually used to index a fixed-size table called a hash table. Use of a hash function to index a hash table is called hashing or scatter storage addressing.
I had a Hash module that I added to the attachment.
The test data in the attachment (your folder tree) was order randomized
The MarkDupsWithHash sub was run to mark dups in red
The data was resorted as a check
If you don't want to use a Hash, then the For i / For j loops should also work, but will be slower I thinkCode:Option Explicit
Sub MarkDupsWithHash()
Dim r As Range
Dim aryHash() As String
Dim i As Long, j As Long
'test
Worksheets("Files").Columns(1).Interior.ColorIndex = xlColorIndexNone
Set r = Worksheets("Files").Cells(1, 1)
Set r = Range(r, r.End(xlDown))
ReDim aryHash(1 To r.Rows.Count)
For i = LBound(aryHash) To UBound(aryHash)
aryHash(i) = CreateSHA256HashString(r.Cells(i, 1).Value)
Next i
For i = LBound(aryHash) To UBound(aryHash) - 1
For j = i + 1 To UBound(aryHash)
If aryHash(j) = aryHash(i) Then r.Cells(j, 1).Interior.Color = vbRed
Next j
Next i
MsgBox "Done"
End Sub