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

您可以使用函数来读取目录以查找特定的后缀并返回名称：

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

遵循此声明

在C：\ BASE \ yyyyyy.c8 \中是，总是只有一个文件夹的名称以.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：文件夹名称未知但扩展名已知的文件夹的路径

2 个答案: