Birden çok dosyanın en sonunu seçin, ardından bir Excel sayfasına aktarın

Question

Aynı klasördeki birkaç dosyanın en son sürümünü seçip bunları Excel'e içe aktarmanın bir yolunu bulmakta zorluk çekiyorum.

Files klasöründeki: Örneğin: Spanish.csv İspanyolca (1) .csv İspanyolca (2) English.csv İngilizce (1) .csv French.csv (birçok vardır .csv İspanyolca (2) .csv İngilizce (1) .csv French.csv

: ama bunun klasöründen

) sadece bu basitlik için dahil ediyorum burada daha fazla dil ve dosyalar, ben bu dosyaları seçmek istediğiniz

ve bunları int'ye aktarın o mevcut bir çalışma sayfası.

Şimdiye kadar var:

Sub GetFiles() 

    Dim MyPath As String 
    Dim Spanish As String 
    Dim English As String 
    Dim French As String 
    Dim LanguageFiles(2) As String 

    MyPath = "C:\example\" 

    'Make sure that the path ends in a backslash 
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" 

    Spanish = Dir(MyPath & "Spanish*.csv") 
    English = Dir(MyPath & "English*.csv") 
    French = Dir(MyPath & "French*.csv") 

    I WANT TO SOMEHOW GET THE MOST RECENT VERSION OF EACH AND PASS IT TO THE LANGUAGEFILES ARRAY AND IMPORT IT TO A SINGLE WORKSHEET. 

    LanguageFiles(0) = Spanish 
    LanguageFiles(1) = English 
    LanguageFiles(2) = French 

For i = LBound(LanguageFiles) To UBound(LanguageFiles) 
     With ActiveSheet.QueryTables.Add(Connection:= _ 
      "TEXT;" & LanguageFiles(i), Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1, 0)) 
      .Name = "Sample" 
      .FieldNames = False 
      .RowNumbers = False 
      .FillAdjacentFormulas = False 
      .PreserveFormatting = True 
      .RefreshOnFileOpen = False 
      .RefreshStyle = xlInsertDeleteCells 
      .SavePassword = False 
      .SaveData = True 
      .AdjustColumnWidth = True 
      .RefreshPeriod = 0 
      .TextFilePromptOnRefresh = False 
      .TextFilePlatform = 437 
      .TextFileStartRow = 1 
      .TextFileParseType = xlDelimited 
      .TextFileTextQualifier = xlTextQualifierDoubleQuote 
      .TextFileConsecutiveDelimiter = False 
      .TextFileTabDelimiter = False 
      .TextFileSemicolonDelimiter = False 
      .TextFileCommaDelimiter = True 
      .TextFileSpaceDelimiter = False 
      .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) 
      .TextFileTrailingMinusNumbers = True 
      .Refresh BackgroundQuery:=False 
     End With 
    Next i 
End Sub 

Ben birlikte birkaç adet cobbling olduğum için bu kod aslında çalışmıyor, ve hatta doğru yolda mıyım bilmiyorum. birileri bana dışarıda yardım edebilir mi lütfen?

Answer 1

Yeri yazdığın alanı içinde aşağıda döngü:

I WANT TO SOMEHOW GET THE MOST RECENT VERSION OF EACH AND PASS IT TO THE LANGUAGEFILES 

Sadece İspanyolca dosyalar için döngü yazdım, ancak kolayca Fransızca, İngilizce, vb yakalamak için başka döngü ekleyebilir dosya ve LanguageFiles dizisine yüklenecek değişken adlarını ayarlayın.

Do While Spanish <> "" 

     If InStr(1, Spanish, "(") Then 'test to see if there is a number 

      Dim bVersion As Boolean 
      bVersion = True 'set this variable to true for later 

      'extract which version it is - will work for any digit version number 
      Dim iVersionTest As Integer, iVersion As Integer 
      iVersionTest = CInt(Mid(Spanish, InStr(1, Spanish, "(") + 1, InStr(1, Spanish, ")") - InStr(1, Spanish, "(") - 1)) 
      'for another method see 
      'iVersionTest = CInt(Split(Split(Spanish,"(")(1),")")(0) 

      'is current version greater than what is already stored? if so, make it latest version 
      Dim sLatestVersion 
      If iVersionTest > iVersion Then 
       sLatestVersion = Spanish 
       iVersion = iVersionTest 
      End If 

     Else 

      'if there's no other version make the lone file the latest version 
      If Not bVersion Then sLatestVersion = Spanish 

     End If 

     Spanish = Dir 

Loop 

LanguageFiles(0) = sLatestVersion