求代码：同一文件名，但不同后缀，VBA调用最新的一个

hwchai

求助：
在同一个文件夹中，有很多文件。 对于同一文件名，只是后缀不同，在VBA调用的时候，如何调用最新的。比如：

aaa.xls   1/19/2015 12:13  更新
aaa.xlsx  1/19/2015  12:43  更新
aaa.xlsm  2/3/2017    15:43  更新

感谢！

liulang0808

http://club.excelhome.net/thread-1258425-1-1.html
这个帖子楼主可以参考下，看看修改时间之类的

hwchai

感谢楼上的信息，但确实没有实现我想要的啊，我是想把 basename相同后缀不同的文件当一个，调取最新的一份。

lsdongjh

用 FileDateTime 读出 文件的修改日期，然后再操作

hwchai

lsdongjh 发表于 2018-4-4 10:19
用 FileDateTime 读出 文件的修改日期，然后再操作

再怎么操作，我是新手，不好意思

hwchai

lsdongjh 发表于 2018-4-4 10:19
用 FileDateTime 读出 文件的修改日期，然后再操作

接下来再怎么操作： 我是新手，不好意思

lsdongjh

1. Sub Test()
   
2.    
   
3.     Dim strMaxDateTime As String
   
4.     Dim strFileName As String
   
5.     Dim lngIndex As Long
   
6.    
   
7.     Dim strFileNames(1 To 10, 1 To 2) As String 'strFileNames(X,1) 时间，strFileNames(X,2)文件名
   
8.    
   
9.     '假设你用FileDateTime  处理了文件，并将文件名和时间存入了 strFileNames  数组
   
10.    
    
11.     For lngIndex = LBound(strFileNames) To UBound(strFileNames)
    
12.         If strMaxDateTime = "" Then
    
13.             strMaxDateTime = strFileNames(lngIndex, 1)
    
14.             strFileName = strFileNames(lngIndex, 2)
    
15.         ElseIf CDate(strMaxDateTime) < CDate(strFileNames(lngIndex, 1)) Then
    
16.             strMaxDateTime = strFileNames(lngIndex, 1)
    
17.             strFileName = strFileNames(lngIndex, 2)
    
18.         End If
    
19.     Next
    
20.    
    
21.     MsgBox "最新的文件名是：" & strFileName & ", 创建时间为： " & strMaxDateTime
    
22. End Sub
    

复制代码

hwchai

lsdongjh 发表于 2018-4-4 11:38

我没有用fileDateTime 处理文件，因为不知道怎么弄。（有些不好意思）

情况是这样的，我又一段程序需要将某个文件夹中的5000个excel的对应行全部贴到一个sheet里面去，  在贴的过程中发现一个问题：文件夹中有大概300个文件是重复文件 （前面的文件名base name 完全相同，就是扩展名有的是.xls，有的是.xlsx,有的是 .xlsm）,对于重复文件，我不管扩展名，只需要如果base name一样，就取最新的那个就好。

文件夹路径：  D:\Temp File\Customer name\
下面有5000多个excel 文件，其中有大概有300个重复文件
需要一段代码来实现  重复文件取最后的目的。

lsdongjh

1. Option Explicit
   
2. 
   
3. Sub Test()
   
4.     Dim objA As Object
   
5.   ' objA就是你要的无重复的文件 字典，KEY是无后缀的文件名，ITEM 是文件全路径全名
   
6.     Set objA = FindFileByName("E:\ebook")
   
7.    
   
8. End Sub
   
9. 
   
10. 
    
11. Function FindFileByName(ByVal strPath As String) As Object
    
12. 
    
13.     Dim objFileDic As Object
    
14.     Dim strFile As String
    
15.     Dim strFileName As String
    
16.     Dim strDateTime_A As String, strDateTime_B As String
    
17.    
    
18.     If Right(strPath, 1) <> "" Then strPath = strPath + ""
    
19.    
    
20.     Set objFileDic = CreateObject("Scripting.Dictionary")
    
21.    
    
22.     strFile = Dir(strPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
    
23.     While strFile <> ""
    
24.         DoEvents
    
25.         If (GetAttr(strPath + strFile) And vbDirectory) <> vbDirectory Then
    
26.             strFileName = Split(strFile, ".")(0)
    
27.             If objFileDic.Exists(strFileName) Then
    
28.                 strDateTime_A = FileDateTime(objFileDic(strFileName))
    
29.                 strDateTime_B = FileDateTime(strPath + strFile)
    
30.                 If CDate(strDateTime_A) < CDate(strDateTime_B) Then objFileDic(strFileName) = strPath + strFile
    
31.             Else
    
32.                 objFileDic(strFileName) = strPath + strFile
    
33.             End If
    
34.             
    
35.         End If
    
36.         strFile = Dir
    
37.     Wend
    
38.    
    
39.     Set FindFileByName = objFileDic
    
40. End Function
    
41. 
    

复制代码