关于导入文件夹中文件名的求助

laterite

按照网上搜罗的代码，实现了将指定路径文件夹、指定文件类型的文件名录入到工作有指定位置。因B列存放文件的其他关联信息，所以当磁盘文件出现删、增、改等变动时，如何达到如下要求：

当新增加磁盘文件后，执行VBA，默认按文件名为序录入工作表，但新增数据所在的行B列为空。比如现在新增一个“3.XXXX.DOCX”文件，按文件名为序则在第7行处插入行并录入数据，B7单元格为空，现有7、8行整行数据向下移动，变为8、9行。

PS：由于word文档在保存在“我的桌面”，各位朋友下载运行代码后数据会不同

ykcbf1100

没有数据文件，代码不好测试。

蓝桥玄霜

可以先提取到最下面一行，然后对A列进行排序一次。

laterite

ykcbf1100 发表于 2024-5-28 12:37
没有数据文件，代码不好测试。

草爷，附件内容略作修改，添加了数据文件，烦请看一下，谢谢

laterite

蓝桥玄霜 发表于 2024-5-28 12:38
可以先提取到最下面一行，然后对A列进行排序一次。

嗯，只是在已有文件名数据列表的情况下，按现有代码，再执行时会履盖原数据，不会提取到最下面一行，关键就是判断新增文件是否在列表数据中。请教蓝版我该如何编写判断语句？

ykcbf1100

laterite 发表于 2024-5-28 14:13
草爷，附件内容略作修改，添加了数据文件，烦请看一下，谢谢

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.28
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Set sh = ThisWorkbook.Sheets("basa")
   
6.     With sh
   
7.         r = .Cells(Rows.Count, 1).End(3).Row
   
8.         arr = .[a1].Resize(r, 1)
   
9.     End With
   
10.     For i = 1 To UBound(arr)
    
11.         s = arr(i, 1)
    
12.         d(s) = i
    
13.     Next
    
14.     ReDim brr(1 To 1000, 1 To 1)
    
15.     p = ThisWorkbook.path & "\测试文件"
    
16.     For Each f In fso.GetFolder(p).Files
    
17.         If LCase$(f.Name) Like "*.doc*" Then
    
18.             fn = f.Name
    
19.             If Not d.exists(fn) Then
    
20.                 m = m + 1
    
21.                 brr(m, 1) = fn
    
22.             End If
    
23.         End If
    
24.     Next f
    
25.     With sh
    
26.         If m > 0 Then
    
27.             .Cells(r + 1, 1).Resize(m, 1) = brr
    
28.             Set Rng = .[a1].Resize(r + m, 3)
    
29.             Rng.Sort .[a1], 1
    
30.         End If
    
31.     End With
    
32.     Set d = Nothing
    
33.     Application.ScreenUpdating = True
    
34.     MsgBox "OK！"
    
35. End Sub
    

复制代码

laterite

ykcbf1100 发表于 2024-5-28 15:21
附件供参考。。。

完全满足预期值，感谢草爷无私的帮助