vba - 文件打开帮助 - Excel 宏

Question

我对脚本比较陌生，因此来这里寻求一些帮助来帮助我构建一个 excel 宏。我目前正在处理一个 excel 文件以加快数据捕获和验证。我无法解决如何获取实际数据的问题。

我目前有一个包含所有文件夹和 excel 文件的驱动器:
Y:\Audit\Accounting_Data\XXXXX_Company_Names\07 Jul 2013\XXXXX.xls
对我来说，第一个问题是每个公司都以不同的文件命名约定发送文件。有些具有数字值的所有日期，而另一些具有字母数字数据(并且顺序不同，即有些是 DD/MM/YYYY，而另一些是 MMMM/DD/YYYY)。我无法修改文件命名约定，因为它们也与其他服务共享，最重要的是我只有对这些文件的读取权限。

第二个问题是每个公司不会在同一天制作文件。有些每天生成审计文件，有些只在工作日生成(然后创建周末的文件并在星期一早上发送给我)>>我正在考虑使用 object.fso 根据他们的 date.created 标准获取最后 10 个文件和让excel在找不到更多文件时停止搜索//前面提到的问题是某些文件是在同一日期创建的。

此外，我试图实现一个循环功能(当它碰到空白单元格时停止)，因为可以从 sheet1 中定义的列表中添加或删除公司。

我想要的是一种让excel转到当前月份文件夹并打开10个以前的excel文件并复制当前工作表中特定单元格的粘贴数据的方法。

这就是我目前想出的:

单元格 A4:A12=文件路径(即 Y:\Audit\Accounting_Data\XXXXX_Company_Names)

var1=file path
var2=month (numeric)
var3=month
var4=year

Range (a4:a50)    
Do Loop till blank cell in Range (a4:a50)
 If cell is not blank then
  goto "var1\var2+var3+var4\"

  Excel is now in Y:\Audit\Accounting_Data\XXXXX_Company_Names\07 Jul 2013\ (hopefully)

我如何告诉 excel 打开相对于今天日期的前 10 个 excel 文件，如果发现少于或没有找到则停止

 Copy Data 
 Paste Data

 Move to next line
   Repeat the Open 10 previous files / Copy / Paste

else when cell is blank

 stop

Answer 1

像这样的东西应该适合你。它应该遍历数组中的每个文件夹并获取存储在文件夹中的所有文件，按日期对它们进行排序，打开最多 10 个文件并将每个文件复制到工作表上。

在此示例中，我使用“Sheet1”作为将所有数据复制到的工作表，并使用名为“DateList”的工作表来存储所有文件路径和创建日期。

Sub Example()
    Dim DirList() As Variant
    Dim Path As Variant
    Dim fso As Object
    Dim dt As Date
    Dim CurrFile As String
    Dim RowOffset As Long

    DirList = Array("C:\Test\", "C:\Test - Copy\")          'Create list of folders to search
    Set fso = CreateObject("Scripting.FileSystemObject")    'Create file system object
    Sheets("DateList").Cells.Delete
    Sheets("DateList").Range("A1").Value = "Path"
    Sheets("DateLIst").Range("B1").Value = "Date Created"

    'Loop through every directory in the list
    For Each Path In DirList()
        CurrFile = Dir(Path)

        'For each file in the current directory
        Do While CurrFile <> ""
            'Get the files date created
            dt = fso.GetFile(Path & CurrFile).DateCreated

            'Add the file data to a "DateList"
            Sheets("DateList").Cells(Sheets("DateList").UsedRange.Rows.Count + 1, 1).Value = Path & CurrFile
            Sheets("DateList").Cells(Sheets("DateList").UsedRange.Rows.Count, 2).Value = Format(dt, "yyyymmdd")

            CurrFile = Dir
        Loop

        Sheets("DateList").Select
        'Sort Files
        With ActiveWorkbook.Worksheets("DateList").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("B1"), _
                            SortOn:=xlSortOnValues, _
                            Order:=xlDescending, _
                            DataOption:=xlSortNormal
            .SetRange Sheets("DateList").UsedRange
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        Sheets("Sheet1").Select
        'Get up to 10 files
        For i = 2 To 11
            If Sheets("DateList").Cells(i, 1).Value = "" Then
                Exit For
            End If

            'Open the file, copy it to the bottom of the data on Sheet1
            '***NOTE*** THIS ASSUMES SHEET1 STARTS OFF BLANK
            Workbooks.Open Sheets("DateList").Cells(i, 1).Value
            ActiveSheet.UsedRange.Copy Destination:=ThisWorkbook.Sheets("Sheet1").Cells(1 + RowOffset, 1)
            RowOffset = RowOffset + ActiveSheet.UsedRange.Rows.Count
            ActiveWorkbook.Close
        Next

        Sheets("DateList").Select
        Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 2)).Delete
        Sheets("Sheet1").Select
    Next
End Sub