Excel VBA：文件夹名称未知但扩展名已知的文件夹路径

Question

我有这个 Excel 文件，用于修改和导出数据集。它导出到同一文件夹，位于：

C:\BASE\yyyyyy.c8\xxxxxx.cv\Addresses.xlsm

我想将此 .xlsm 存储在：

C:\BASE\yyyyyy.c8\

相反，但我仍然需要导出到

C:\BASE\yyyyyy.c8\xxxxxx.cv\

文件夹。然而，这很棘手，因为 xxxxxx.cv 文件夹名称将项目更改为项目，但是此文件夹名称的 .cv 扩展名始终相同。

目前它使用以下方法将文件导出到 excel 文件的根文件夹：

convFileName = ActiveWorkbook.Path & "\conv" & convTableNumber

我希望它基本上像这样工作，显然这行不通，但我将如何实现此功能？

 convFileName = ActiveWorkbook.Path & \*.cv & "\conv" & convTableNumber

编辑。解决方案：

Dim sFile As String, sPathSeek As String, sPathMatch As String
On Error Resume Next
sPathSeek = ActiveWorkbook.Path & "\*.cv"
sFile = Dir(sPathSeek, vbDirectory)

Do While Len(sFile) > 0
    If Left(sFile, 1) <> "." Then
        If (GetAttr(sFile) And vbDirectory) = vbDirectory Then
            sPathMatch = sFile
            Exit Do
        End If
    End If
    sFile = Dir
Loop

convFileName = ActiveWorkbook.Path & "\" & sPathMatch & "\conv" & convTableNumber

Answer 1

您可以使用函数读取目录以查找特定后缀和return名称是什么：

Function FindFileNameBySuffix(InDir As String, suffix As String)


    Dim foundFileName     As String
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(InDir)
    Set oFiles = oFolder.Files

    If oFiles.Count = 0 Then Exit Function

    ReDim vaArray(1 To oFiles.Count)

    For Each oFile In oFiles
        If Right(oFile.Name, Len(suffix)) = suffix Then
            FindFileNameBySuffix = oFile.Name
            Exit Function
        End If
    Next


End Function

Answer 2

遵守此声明

Yes in C:\BASE\yyyyyy.c8\ there is always just one folder with name ending in .cv

我借用了这个代码形式 here 并做了一些调整

Sub Find_SubFolder()
    Dim sFile As String, sPathSeek As String, sPathMatch As String

    Const sMainPath As String = "C:\BASE\yyyyyy.c8\"

    On Error Resume Next
    sPathSeek = sMainPath & "*.cv"
    sFile = Dir(sPathSeek, vbDirectory)

    Do While Len(sFile) > 0
        If Left(sFile, 1) <> "." Then
            If (GetAttr(sFile) And vbDirectory) = vbDirectory Then
                sPathMatch = sFile
                Exit Do
            End If
        End If
        sFile = Dir
    Loop

    'From here you can put your code to save your file...
    Debug.print "C:\BASE\yyyyyy.c8\" & sPathMatch & "\"
End Sub

Excel VBA：文件夹名称未知但扩展名已知的文件夹路径

Excel VBA: path to folder with unknown foldername but known extension

excel

vba

wildcard