Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/26.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 从特定日期后创建的不同工作簿中收集信息_Vba_Excel - Fatal编程技术网

Vba 从特定日期后创建的不同工作簿中收集信息

Vba 从特定日期后创建的不同工作簿中收集信息,vba,excel,Vba,Excel,我目前正在使用以下代码将各种工作簿中的特定单元格内容收集到跟踪表中 Sub CopyRangeValues() Dim basebook As Workbook Dim mybook As Workbook Dim FNames As String Dim rnum As Long Dim y As Variant Application.ScreenUpdating = False ChDrive "D:\" Ch

我目前正在使用以下代码将各种工作簿中的特定单元格内容收集到跟踪表中

Sub CopyRangeValues() 
    Dim basebook As Workbook 
    Dim mybook As Workbook 
    Dim FNames As String 
    Dim rnum As Long 
    Dim y As Variant 
    Application.ScreenUpdating = False 
    ChDrive "D:\" 
    ChDir "D:\" 
    FNames = Dir("Sample-*.xl*") 
    If FNames <> "" Then 
        Set basebook = ThisWorkbook 
        y = InputBox("What column should start getting the values", "Input Row Value", 2) 
        If y = "" Then Exit Sub 'cancel hit
        rnum = Val(y) 
        Do While FNames <> "" 
            Set mybook = Workbooks.Open(FNames) 
            basebook.Worksheets(1).Cells(rnum, 1).Value = mybook.Worksheets(1).Range("D1").Value 
            basebook.Worksheets(1).Cells(rnum, 2).Value = mybook.Worksheets(1).Range("G1").Value 
            basebook.Worksheets(1).Cells(rnum, 3).Value = mybook.Worksheets(1).Range("C5").Value 
            basebook.Worksheets(1).Cells(rnum, 4).Value = mybook.Worksheets(1).Range("C8").Value 
            basebook.Worksheets(1).Cells(rnum, 5).Value = mybook.Worksheets(1).Range("C9").Value 
            mybook.Close False 
            rnum = rnum + 1 
            FNames = Dir() 
        Loop 
    End If 
    Application.ScreenUpdating = True 
End Sub

我正在尝试修改代码,以便在我完成初始收集后,当激活时,它将只收集自上次运行以来添加的工作簿中的信息。因为所有工作簿的创建日期都在同一个单元格中,所以我尝试将其作为搜索条件。任何帮助都将不胜感激,谢谢

假设创建日期在第6列中,否则进行相应修改

首先,声明并分配一个日期变量用于开始日期,小于此值的值将不会被使用

    Dim startDate as Date
    startDate = #1/1/2014#   '<-- Modify as needed

为文件名和上次更新日期添加一列:然后您可以使用该列确定是否添加/更新给定文件中的信息。哇,我没有意识到人们实际上使用Dir等。我会选择Windows脚本运行时在文件夹中列出文件,然后循环检查每个文件的创建日期。这意味着我不必打开每个工作簿来检查单元格。
    Dim dateColumn as Integer
    dateColumn = 6           '<-- Modify as needed
    Do While FNames <> "" 
        IF CDate(basebook.Worksheets(1).Cells(rnum, dateColumn).Value) >= startDate
        Set mybook = Workbooks.Open(FNames) 
        basebook.Worksheets(1).Cells(rnum, 1).Value = _
           mybook.Worksheets(1).Range("D1").Value 
        basebook.Worksheets(1).Cells(rnum, 2).Value = _
           mybook.Worksheets(1).Range("G1").Value 
        basebook.Worksheets(1).Cells(rnum, 3).Value = _
           mybook.Worksheets(1).Range("C5").Value 
        basebook.Worksheets(1).Cells(rnum, 4).Value = _
           mybook.Worksheets(1).Range("C8").Value 
        basebook.Worksheets(1).Cells(rnum, 5).Value = _
           mybook.Worksheets(1).Range("C9").Value 
        mybook.Close False 
        End If
        rnum = rnum + 1 
        FNames = Dir() 
    Loop