检索目录中最后一个文件夹的文件夹名称

Question

我正在致力于自动化我们通过 Excel 工作簿执行的采购订单的保存过程。而不是用户必须将模板复制到正确的目录中并使用顺序中下一个正确的订单号以及日期重命名它（例如，之前的订单是订单号 SJ-K1880 于 2016 年 7 月 7 日下达，文件名KO_SJ-K1880_070716，所以下一个订单号是 SJ-K1881 于 2016 年 7 月 11 日下单，文件名为 KO_SJ-K1881_110716），用户只需单击“保存”按钮，即可将工作簿保存在右侧的正确目录中文件名自动跟随顺序。这是一个此类文件的完整目录的示例：

C:\Users\User\Desktop\Kyocera Order Doc\
Kyocera Orders\Orders 2016\07 July 2016\
KO SJ-K1880 070716\KO_SJ-K1880_070716.xlsm

使用当前日期，我设法检查了直到 07 July 2016 的目录是否存在，如果不存在则创建它。我的问题在于从该目录中找到最后一个文件夹（在此示例中为 KO SJ-K1880 070716）并使用它来确定下一个订单号将是什么。

Answer 1

这似乎可以满足您的需求，但它依赖于文件夹名称的升序。

Option Explicit

Sub main()
    Dim fldr As String

    fldr = Environ("USERPROFILE") & _
        "\Desktop\Kyocera Order Doc\Kyocera Orders\Orders 2016\07 July 2016"

    Debug.Print mostRecentFolderNdx(fldr)
End Sub

Function mostRecentFolderNdx(base As String)
    Dim f As String, lstndx As String

    f = Dir(base & "\*", vbDirectory)
    Do While CBool(Len(f))
        If Not CBool(InStr(1, f, Chr(46))) Then
            lstndx = Split(f, Chr(32))(UBound(Split(f, Chr(32))))
        End If
        f = Dir
    Loop

    mostRecentFolderNdx = lstndx
End Function

如果您要依赖升序排序，最好让您的文件夹使用\20160707\ 之类的命名约定，而不是\07 July 2016\。