求助--如何检查文件夹下存在前6个字是相同的文件？

xixi0603

lsdongjh 发表于 2018-6-19 14:58
F8 单步执行，看看

求助3.rar (41.58 KB, 下载次数: 2)

2018-6-19 15:09 上传

点击文件名下载附件

F8试了一下，基本都是Do第二次以后就直接退出了，，可是文件里已经没有重复的了，请老师看看附件。

lsdongjh

FileName = Dir '少了这句！

xixi0603

lsdongjh 发表于 2018-6-19 15:14
FileName = Dir '少了这句！

太棒了，，终于可以用了，谢谢老师指导！！

duquancai

xixi0603 发表于 2018-6-19 14:32
我把重复的文件删除以后再试用，却还是提示有重复，怎么办呢？

'手机敲的代码，未必正确！
sub main()
dim p$
p = ThisWorkbook.Path & "\原始\"
if fu(p) then
    msgbox "有重复"
else
    msgbox "没有重复"
end if
end sub
function fu(s$) as boolean
    Dim dic As Object, p$, f$
    Set dic = CreateObject("Scripting.Dictionary")
    f = Dir(s & "*.xls*")
    Do While f <> ""
        p = Left(f, 7)
        If not dic.Exists(p) Then
            dic(p) = vbnull
         else
            fu = True:Exit function
        End If
     f=dir()
    Loop
End function

xixi0603

duquancai 发表于 2018-6-19 15:37
'手机敲的代码，未必正确！
sub main()
dim p$

谢谢你啦，上面有位老师已经给出了答案。但还是谢谢你的热心帮助！！