Вставить новое имя файла в Excel VBA

Question

Ниже приводится макрос, который я записал для проекта, над которым я работаю. Появляется новый текстовый файл, который поступает еженедельно (в этом примере имя файла HMO04102015.txt), и мне интересно, есть ли способ (возможно, дополнительный макрос, который я могу добавить в код), чтобы я мог вытащить новое еженедельное имя файла и замените его автоматически (возможно, как функция «вытащить последнюю временную метку»). Файлы появляются в тот же день недели, поэтому я знаю, в какой день они придут (если это вообще поможет).

Sub textimport() 
' 
' textimport Macro 
' 
    With ActiveSheet.QueryTables.Add(Connection:= _ 
      "TEXT;C:\Users\Employee\Desktop\Test Data\HMO04102015.txt", _ 
      Destination:=Range("$A$1")) 
     .Name = "HMO04102015" 
     .FieldNames = True 
     .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 = xlFixedWidth 
     .TextFileTextQualifier = xlTextQualifierDoubleQuote 
     .TextFileConsecutiveDelimiter = False 
     .TextFileTabDelimiter = True 
     .TextFileSemicolonDelimiter = False 
     .TextFileCommaDelimiter = False 
     .TextFileSpaceDelimiter = False 
     .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) 
     .TextFileFixedColumnWidths = Array(11, 29, 9, 7, 2, 3, 167, 51, 39, 18) 
     .TextFileTrailingMinusNumbers = True 
     .Refresh BackgroundQuery:=False 
    End With 
    Columns("C:C").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("F:F").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("A:A").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("A:A").EntireColumn.AutoFit 
    Selection.ColumnWidth = 27 
    Range("B2").Select 
End Sub 

Answer 1

Да, вы можете использовать Application.GetOpenFilename, чтобы выбрать файл. См. Этот код

Если вы хотите файл с недавней меткой времени, то это может быть легко ADDED. Вам придется перебирать файлы в папке с помощью DIR и проверять последнюю временную метку.

Sub textimport() 
    Dim Ret 

    Ret = Application.GetOpenFilename("Text Files (*.txt), *.txt") 

    If Ret <> False Then 
     With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Ret, _ 
     Destination:=Range("$A$1")) 
      ' 
      '~~> Rest of the code 
      ' 
     End With 
    End If 
End Sub