DIR无法正常工作

我正在使用VBA将.txt文件中的数据导入到我的电子表格的表格中,该表格用于进一步的数据透视表。 我从中导入文件的networking目录包含〜5500个文件,并且会随着时间的推移而增长,目前每年大约有2000个文件。 表中的条目按datesorting(从最旧到最新)。

我有一个macros检查最近的条目的date,然后使用DIRsearchnetworking位置,并遍历该目录中的文件。 对于每个文件,如果文件比最近的条目新,我想导入数据并将其添加到表中。 如果文件较旧,我想要DIR移动到下一个文件。 以下是我目前使用的代码。

Sub NewFilesFromNetwork() Dim myDatabase As Worksheet Set myDatabase = Sheets("Database") Dim TotalRows As Long, LastDate As Date TotalRows = myDatabase.ListObjects("Table1").Range.Rows.Count LastDate = Cells(TotalRows + 48, 6).Value 'the "+48" here is important because there are 48 hidden rows at the top of the spreadsheet before the table starts Dim MyFolder As String, MyFile As String On Error Resume Next Application.ScreenUpdating = False MyFolder = "*path to my network location*" MyFile = Dir(MyFolder & "*.txt") Dim t As Integer, k As Integer t = 0 'counter for calculating total files imported k = 0 'counter for calculating total files checked Do While MyFile <> "" TxtFile = MyFolder & MyFile If FileDateTime(TxtFile) > LastDate Then Open TxtFile For Input As #1 Do Until EOF(1) Line Input #1, textline text = text & textline Loop Close #1 Call CommonImportCode 'separate sub which picks out information from the .txt file string and adds it to the table as a new entry k = k + 1 t = t + 1 MyFile = Dir() End If k = k + 1 MyFile = Dir() Loop Application.ScreenUpdating = True MsgBox "Number of files searched = " & k & vbNewLine & "Number of files imported = " & t End Sub 

我遇到的问题是这样的:

我可以检查networking位置,看到有10个新的文件。 但是,macros只能导入其中的5个,而且似乎只能导入新文件的每隔一个文件。 当macros满足IF语句的条件时,是否有理由跳过文件?

  k = k + 1 MyFile = Dir() 

该代码是重复的。 如果上面的“如果”是真的,那么你跳过一个文件。 你的循环应该是:

 Do While MyFile <> "" TxtFile = MyFolder & MyFile If FileDateTime(TxtFile) > LastDate Then Open TxtFile For Input As #1 Do Until EOF(1) Line Input #1, textline text = text & textline Loop Close #1 Call CommonImportCode 'separate sub which picks out information from the .txt file string and adds it to the table as a new entry t = t + 1 End If k = k + 1 MyFile = Dir() Loop 

或接近的东西。