Excel VBA: путь к папке с неизвестным именем, но известным расширением - PullRequest
Новая
       11

Excel VBA: путь к папке с неизвестным именем, но известным расширением

0 голосов
/ 05 июня 2019

У меня есть Excel файл, который я использую для изменения и экспорта наборов данных.Он экспортируется в ту же папку, расположенную в: 

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

Я хотел бы сохранить это .xlsm в: 

C:\BASE\yyyyyy.c8\

, но мне все еще нужно экспортировать в

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

папка.Однако это сложно, так как xxxxxx.cv Foldername меняет проект на проект, однако расширение .cv этого Foldername всегда одинаково.

В настоящее время для экспорта файлов в корневую папку файла 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

Ответы [ 2 ]

0 голосов
/ 05 июня 2019

Исходя из этого утверждения

Да, в C: \ BASE \ yyyyyy.c8 \ всегда есть только одна папка с именем, оканчивающимся на .cv

Я позаимствовал эту кодовую форму здесь и немного подправил 

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
0 голосов
/ 05 июня 2019

Вы можете использовать функцию для чтения каталога, чтобы найти определенный суффикс и вернуть его имя: 

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
...