windows - 打开具有通用名称部分的文件

Question

首先，请原谅我在提出问题时的不足，因为我对 VBA 的了解不多。非常感谢您的帮助。

我正在从事一个项目，该项目意味着将来自三个不同子文件夹的三个不同 Excel 文件的内容放入一个 Excel 文件中，然后运行一些宏以处理它们包含的数据。由于我已经设置了处理宏，我的问题在于正确导入内容。

我面临的问题是我没有想要打开的文件的确切名称，而且它们每个月都会更改。因此，我不能使用需要精确名称的“WorkBooks.Open”命令。但是，这些文件具有可预测的名称格式。例如，其中一个子文件夹将由名为“XXX-jan2013.xls”的文件组成，另一个名为“january2013-XXX”，最后一个名为“XXX-01/2013”​​。

我的目标是手动输入月份和年份，例如“01/2013”​​，然后打开名称中包含“January”、“jan”或“01”的所有文件。

这是我到目前为止的内容，附有评论:

Sub ChosenDate()
‘It aims at opening a box in which the desired month would be written manually
Dim InputDate As String
‘These are the indications the user will get
    InputDate = InputBox(Prompt:="Please choose a month.", _
            Title:="Date", Default:="MM/YYYY")
‘In case the person forgets to write what he’s asked to
          If InputDate = "MM/YYYY" Or _
          InputDate = vbNullString Then
          Exit Sub
‘If he does it correctly, I call the second Sub
         Else: Call FilesOpening
        End If
End Sub
‘So far, everything works fine

Public Sub FilesOpening()
‘This one aims at opening the chosen files
Dim ThisFile               As String
Dim Files                    As String
 ‘Defining the folder in which the file is, as it can change from a computer to another
ThisFile = ThisWorkbook.Path
‘Here’s where I start struggling and where the macro doesn’t work anymore
‘If I wanted to open all the files of the folder, I would just write that:
Files = Dir(ThisFile & "\*.xls")
‘You never know…
On Error Resume Next
‘Creating the Loop
Do While Files <> vbNullString
Files = Dir
Set wbBook = Workbooks.Open(ThisWorkbook.Path & "\" & Files)
Loop
End Sub
‘But it doesn’t look inside of sub-folders, neither does it consider the date
Sub DataProcess()
‘This one is fine, except I can’t find a way to name the files correctly. Here’s the beginning:
Windows("I don’t know the name.xls").Activate
Sheets("Rapport 1").Select
Cells.Select
Selection.Copy
Windows("The File I Want To Put Data In.xlsm").Activate
Sheets("Where I Want To Put It").Select
Range("A1").Select
ActiveSheet.Paste
Windows("I don’t know the name.xls").Close
‘How can I get the name?

我希望我的陈述是可以理解的。

非常感谢您!

祝你有个愉快的一天

E.

Answer 1

您需要构建一个路径列表和预期的文件掩码。然后您可以循环每个匹配的文件并执行您的操作。

Sub foo()
Dim request As String:  request = "01/2013"
'//make a date
Dim asDate   As Date:   asDate = "01/" & request
Dim dirs(2) As String, masks(2) As String

dirs(0) = "c:\xxx\dir1\"
masks(0) = "*" & Format$(asDate, "mmmmyyyy") & "*.xls"

dirs(1) = "c:\xxx\dir2\"
masks(1) = "*" & Format$(asDate, "mmmyyyy") & "*.xls"

dirs(2) = "c:\xxx\dir3\"
masks(2) = "*" & Format$(asDate, "mmyyyy") & "*.xls"

Dim i As Long
For i = 0 To UBound(dirs)
    GetFiles dirs(i), masks(i)
Next
End Sub

Private Function GetFiles(path As String, mask As String)
Dim file As String
'//loop matching files
file = Dir$(path & mask)
Do Until Len(file) = 0
    '//process match
    process path & file
    file = Dir$()
Loop
End Function

Sub process(filePath As String)
    MsgBox "processing " & filePath
    'workbook.open
End Sub

因为 "XXX-01/2013" 不是我假设的文件名 "XXX-012013"。如果它是另一个子目录:

dirs(x) = "c:\xxx\dir3\" & Format$(asDate, "mm") & "\"
masks(x) = "*" & year(asDate) & "*.xls"