I am currently using the below code to list all files found in a folder. I would like to filter it down to only list the files that are found in my workbook located in column A.
Column A lists an invoice number that is the name of each file in the folder. Eg. 009867- 2345 listed in column A, represents file name 009867- 2345.xls in the folder.
I only want the printed out list in the macro to list the files that match Column A.
Column A lists an invoice number that is the name of each file in the folder. Eg. 009867- 2345 listed in column A, represents file name 009867- 2345.xls in the folder.
I only want the printed out list in the macro to list the files that match Column A.
VBA Code:
Sub ListAllLinkInfoInFolders()
Dim MyPath As String, MyFolderName As String, MyFileName As String, key As Variant
Dim i As Integer, F As Boolean
Dim objShell As Object, objFolder As Object, AllFolders As Object, AllLinkInfo As Object
Dim MySheet As Worksheet
On Error Resume Next
MyPath = "\\192.168.1.11\Shared Files\Purchasing\RPUI\RPUI International Shipment Trackers\International Shipment Tracker Invoices (Do Not Mess With)\"
Set objFolder = Nothing
Set objShell = Nothing
'List all folders
Set AllFolders = CreateObject("Scripting.Dictionary")
Set AllLinkInfo = CreateObject("Scripting.Dictionary")
AllFolders.Add (MyPath), ""
i = 0
Do While i < AllFolders.Count
key = AllFolders.keys
MyFolderName = Dir(key(i), vbDirectory)
Do While MyFolderName <> ""
If MyFolderName <> "." And MyFolderName <> ".." Then
If (GetAttr(key(i) & MyFolderName) And vbDirectory) = vbDirectory Then
AllFolders.Add (key(i) & MyFolderName & "\"), ""
End If
End If
MyFolderName = Dir
Loop
i = i + 1
Loop
'List all files
For Each key In AllFolders.keys
MyFileName = Dir(key & "*.*")
'MyFileName = Dir(Key & "*.PDF") 'only PDF files
Do While MyFileName <> ""
AllLinkInfo.Add (key & MyFileName), ""
MyFileName = Dir
Loop
Next
'List all files in LinkInfo sheet
Sheets("LinkInfo").Activate
For Each MySheet In ThisWorkbook.Worksheets
If MySheet.Name = "LinkInfo" Then
Sheets("LinkInfo").Cells.Delete
F = True
Exit For
Else
F = False
End If
Next
If Not F Then Sheets.Add.Name = "LinkInfo"
Sheets("LinkInfo").[A1].Resize(AllLinkInfo.Count, 1) = WorksheetFunction.Transpose(AllLinkInfo.keys)
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
Sheets("LinkInfo").[A1].Resize(AllLinkInfo.Count, 1) = WorksheetFunction.Transpose(AllLinkInfo.keys)
Set AllFolders = Nothing
Set AllLinkInfo = Nothing
Columns("B:G").Select
Selection.Delete Shift:=xlToLeft
Columns("B:G").EntireColumn.AutoFit
Sheets("LinkInfo").Range("C1").Value = "=LEFT(RC[-1],11)"
Dim LastRow As Long
LastRow = Sheets("LinkInfo").Range("A" & rows.Count).End(xlUp).Row
Range("C1").Copy Range("C1:C" & LastRow)
Calculate
Columns("C:C").Value = Columns("C:C").Value
Columns("A:C").EntireColumn.AutoFit
End Sub