Мне кажется, я начинаю понимать, что вы пытаетесь сделать. Мой вердикт состоит в том, что вам не понадобится словарь, если я вас правильно и полностью понимаю. Приведенный ниже код записывает словарь, но ему не нужно определять, что записывать на лист. В конце словарь содержит список имен файлов с объектами файлов как Items
, в то время как на листе есть только имена файлов. Вы можете удалить все ссылки на словарь, не затрагивая остальную функциональность кода.
Option Explicit
Public Dict As Scripting.Dictionary ' prefer early binding
Sub Test1()
' early binding works faster and gives you Intellisense access.
' use late binding only if your program will run on different versions of Excel
Dim oFSO As FileSystemObject ' prefer early binding
Dim oFolder As Folder
Dim oFile As File
Dim Rng As Range
Dim Fn As String ' Base file name
Dim Ws As Worksheet
Dim R As Long
If Dict Is Nothing Then
Set Dict = CreateObject("Scripting.Dictionary")
End If
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\Users\Public\Desktop\")
Set Ws = CreateOutputSheet(ActiveWorkbook)
For Each oFile In oFolder.Files
Fn = oFSO.GetBaseName(oFile)
With Ws
Set Rng = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
On Error Resume Next
R = Application.Match(Fn, Rng, 0)
' write to worksheet
If Err Then Rng.Cells(Rng.Cells.Count + 1).Value = Fn
' write to dictionary
If Not Dict.Exists(Fn) Then
Dict.Add Key:=Fn, Item:=oFile
End If
Next oFile
End Sub
Private Function CreateOutputSheet(ByVal Wb As Workbook) As Worksheet
Dim Ws As Worksheet
On Error Resume Next
With Wb.Worksheets
Set Ws = .Item("Data")
If Err Then
Set Ws = .Add(After:=.Item(.Count))
Ws.Name = "Data"
End If
End With
On Error GoTo 0
' AddColumnHeaders Ws
Ws.Cells(1, "A").Value = "FileNames" ' remove
Set CreateOutputSheet = Ws
End Function
Часть, которую я до сих пор не понимаю, - как вы найдете файл, который уже есть в списке, так как вы удаляйте список при каждом запуске и начинайте новый. Возможно, ваше намерение состоит в том, чтобы изменить это. Дайте мне знать, если вам нужна помощь, чтобы найти свой код.