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?

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

非常感谢你！

度过愉快的一天，

电子。

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"

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

1 个答案: