在主文件夹或子文件夹上获取仅为"最高数字"的文件名的完整路径



我正在使用数据库软件,并从中导出excel文件,并将其保存在桌面上,名称为********.xls
*****仅表示数字,例如08134471.xls
223222578.xls
文件名上的数字在计数和长度上是随机的
路径是恒定的D:UsersWaleedDesktop,但文件名每次都会递增地更改为更大的数字
所以,我需要在引用的路径上打开带有highest number的工作簿
提前感谢您的帮助

Sub Open_Numeric_File()

Workbooks.Open "D:UsersWaleedDesktop8134471.xls"

End Sub

请尝试下一个函数。它将独立于数字名称模式返回。我的意思是;0002345";或";02346";,它处理文件夹和子文件夹中的所有文件:

Function getLastFileName(strFold As String, Optional strext As String = "*.*") As String
Dim arrD, i As Long, lastName As String, lngNb As Long, arrN, El
'return all files name in an array
arrD = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & strFold & strext & """ /b /s").StdOut.ReadAll, vbCrLf), "")
For Each El In arrD   'iterate between the array elements
arrN = Split(El, "") 'make an array splitting the name by ""
'check if the name is numeric:
If IsNumeric(Split(arrN(UBound(arrN)), ".")(0)) Then
'compare the lngNb variable (initially 0) with the numeric value:
If lngNb < CLng(Split(arrN(UBound(arrN)), ".")(0)) Then
'addapt lngNb like the bigger number
lngNb = CLng(Split(arrN(UBound(arrN)), ".")(0)): lastName = El
End If
End If
Next
getLastFileName = lastName 'build the necessary path
End Function

它可以通过下一种方式进行测试:

Sub testGetLastFileName()
Debug.Print getLastFileName("D:UsersWaleedDesktop", "*.xls*")
End Sub

它排除了不是数字的工作簿名称。。。

编辑

下一个版本只返回(并处理(主文件夹中的文件(不包括子文件夹中的文件夹(:

Function getLastNumberFile(strFold As String, Optional strext As String = "*.*") As String
Dim arrD, i As Long, lastName As String, lngNb As Long, El
'return all files name in an array
arrD = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & strFold & strext & """ /b").StdOut.ReadAll, vbCrLf)
If UBound(arrD) = -1 Then MsgBox "Nothing could be found in the path you supplied...": Exit Function
arrD(UBound(arrD)) = "@@##": arrD = Filter(arrD, "@@##", False) 'remove the last (empty) element
For Each El In arrD   'iterate between the array elements
If IsNumeric(Split(El, ".")(0)) Then
'compare the lngNb variable (initially 0) with the numeric value:
If lngNb < CLng(Split(El, ".")(0)) Then
'addapt lngNb like the bigger number
lngNb = CLng(Split(El, ".")(0)): lastName = El
End If
End If
Next
getLastNumberFile = strFold & lastName 'build the necessary path
End Function

它可以简单地将必要的工作簿设置为:

Set wb1 = Workbooks.Open(getLastNumberFile("D:UsersWaleedDesktop", "*.xls*"))

和下一个版本,能够返回两种情况。它使用了一种技巧,使用通过在文件夹路径和"之间串联而获得的分隔符来分割连接的数组|&";。然后删除最后一个数组元素(如果返回时没有子文件夹文件(:

Function getLastFileN(strFold As String, Optional strext As String = "*.*", Optional boolSubfolders = False) As String
Dim arrD, i As Long, lastName As String, lngNb As Long, arrN, El
'return all files name in an array
If boolSubfolders Then 'subfolders included
arrD = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & strFold & strext & """ /b/s").StdOut.ReadAll, vbCrLf), "")
Else                   'without subfolders
arrD = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & strFold & strext & """ /b").StdOut.ReadAll, vbCrLf)
arrD = Split(strFold & Join(arrD, "|" & strFold), "|")  'add the folder path to the file names
arrD(UBound(arrD)) = "@@##": arrD = Filter(arrD, "@@##", False) 'remove the last (empty) array element
End If
For Each El In arrD           'iterate between the array elements
arrN = Split(El, "") 'make an array splitting the name by ""
'check if the name is numeric:
If IsNumeric(Split(arrN(UBound(arrN)), ".")(0)) Then
'compare the lngNb variable (initially 0) with the numeric value:
If lngNb < CLng(Split(arrN(UBound(arrN)), ".")(0)) Then
'addapt lngNb like the bigger number
lngNb = CLng(Split(arrN(UBound(arrN)), ".")(0)): lastName = El
End If
End If
Next
getLastFileN = lastName
End Function

您需要考虑的事项:

Sub OpenAndCalc()
Dim myDir As String, fn As String, high As String, highVal As Long
myDir = "D:UsersWaleedDesktop"
fn = Dir(myDir & "*.xls")

Do While fn <> "" And Not fn Like "*[!0-9]*.xls"
If Val(fn) > highVal Then highVal = Val(fn): high = fn
fn = Dir()
Loop
Workbooks.Open myDir & high

End Sub

这应该:

  • 循环浏览静态目录中的所有".xls"文件
  • 通过Like()测试".xls"之前的内容是否为数字
  • 使用Val(),对照上一个(或空(值测试数字子字符串
  • 附加具有最高值的静态目录并打开此工作簿

您可以列出文件夹中的所有文件,将它们放入工作表/数组中,然后按文件名对它们进行排序

下面有一段来自VBATips 的非常好的代码

Dim iRow
Sub ListFiles()
iRow = 11
Call ListMyFiles(Range("C7"), Range("C8"))
End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
iCol = 2
Cells(iRow, iCol).Value = myFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.DateLastModified
iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub

这将在Excel中列出文件夹中的所有文件,您可以将更改为数组

之后,只需在myFile.DateLastModified 上对它们进行排序

对不起,这不是一个完整的答案,有一分钟的空闲时间,并认为这可能会帮助你

部分来源:http://excelexperts.com/VBA-Tips-List-Files-In-A-Folder

或者类似的东西:

使用VBADir()函数循环访问文件夹中的所有.xls文件(而不是目录等(。它将前面的文本从"中分离出来&";,并试图将其转换为数字,同时跟踪找到的最大数字。

如果在32位系统上,则用Long替换LongLong,用CLng替换CLngLng

Sub ListFiles()
Dim llFile As LongLong
Dim llMax As LongLong
Dim strFileToOpen As String
Dim strPath As String
Dim strFile As String

strPath = Environ("USERPROFILE") & "Desktop*.xls"
strFile = Dir(strPath, vbNormal)

On Error Resume Next

While Len(strFile) > 0
llFile = 0
llFile = CLngLng(Split(strFile, ".")(0))
If llFile > 0 And llFile > llMax Then
llMax = llFile
strFileToOpen = strFile
End If

strFile = Dir()
Wend
On Error Goto 0

If Len(strFileToOpen) > 0 Then Workbooks.Open (strPath & "" & strFileToOpen)
End Sub

相关内容

最新更新