Зацикливание на неизвестное количество файлов в папке - PullRequest
Новая
       3

Зацикливание на неизвестное количество файлов в папке

0 голосов
/ 24 октября 2019

У меня есть папка с файлами Excel, имя которой отформатировано "file_" & Date & _ "& i &" .xls ", где i - целое число от 1 до 5.

На основеdate В папке может быть любое число от 1 до 5 файлов: 

file_01.01.2019_1.xls
file_02.01.2019_1.xls
file_02.01.2019_2.xls
file_03.01.2019_1.xls
file_03.01.2019_2.xls
file_03.01.2019_3.xls

Я хочу указать дату, скажем, 2 января, и в цикле for откройте все файлы с этой даты. не могу дать фиксированное верхнее значение для i.

Если бы я знал количество файлов на дату, это выглядело бы так: 

Dim Date As Date
Date = 02.01.2019

For j = 1 To i
    Workbooks.Open "path" & "file_" & Date & "_" & j & ".xls"
    Copy and Paste Operations to another Workbook here
    Workbooks("file_" & Date & "_" & j & ".xls").Close SaveChenges:=False
Next

Ответы [ 3 ]

1 голос
/ 24 октября 2019

Вы можете попробовать этот простой код: 

Sub OpenFile()
   Dim dt As String
   dt = "02.01.2019"
   Dim fileNameStart  As String
   fileNameStart = "file_" & dt & "_"

   Dim oFile       As Object
   Dim oFSO        As Object
   Dim oFolder     As Object
   Dim oFiles      As Object
   Dim oPath       As String
   sPath = "path to your folder, with \ at the end"

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

   If oFiles.Count = 0 Then Exit Sub

   For Each oFile In oFiles
        If InStr(1, oFile.Name, fileNameStart) = 1 Then Workbooks.Open sPath & oFile.Name
   Next

End Sub
0 голосов
/ 24 октября 2019

другой подход выиграл бы от сознательного использования оператора On Error Resume Next в следующей функции: 

Function OpenWb(wbFullName As String, wb As Workbook) As Boolean
    Set wb = Nothing
    On Error Resume Next
    Set wb = Workbooks.Open(wbFullName)
    OpenWb = Not wb Is Nothing
End Function

, которая возвращает False в случае, если рабочая книга не существует, и True, если рабочая книга найдена, вместе сс его (действительной) wb ссылкой и, следовательно, будет использоваться следующим образом: 

Dim Data As String
Data = "02.01.2019"

Dim path As String
path = "full folder path"

Dim j As Long
Dim wb As Workbook
For j = 1 To 5
    If OpenWb(path & "\file_" & Data & "_" & j & ".xls", wb) Then
        With wb ' reference opened workbook
            'Copy and Paste Operations from 'wb' to another Workbook here
            'for instance:
            .Worksheets("WbWorksheetName").Range("WbRange").Copy Destination:=otherWb.Worksheets("otherWbWorksheetName").Range("otherWbRange")

            .Close SaveChanges:=False
        End With
    End If
Next
0 голосов
/ 24 октября 2019

Проверка в цикле: файл существует для каждого дня.
Файл VBA существует

ОК. код будет выглядеть примерно так: NB !! Функция IsFile (ByVal fName As String) As Boolean (R) 

Dim i as integer
Dim dirpath as string
Dim sDate as string
dirpath = "C:\Path\To\Needed\Folder\"
sDate = "02.01.2019"
for i = 1 to 5
    if IsFile(dirpath & "file_" & sDate & "_" & i & ".xls") then
         'do something
    end if
next

Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
    On Error Resume Next
    IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function
...