Как я могу динамически изменить имя файла в пути к файлу?

Question

Я хочу импортировать несколько файлов TXT в Excel (на один лист - каждый файл имеет только 6 строк).Как я могу изменить путь к файлу в каждом цикле (я возьму его за цикл)?

Sub openfile()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\HarrsionDavid\Desktop\\source\customer.txt", _
        Destination:=Range("A1"))
        .Name = "customer.txt"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1250
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 9, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A1:C3").Selection
    Selection.Delete Shift:=x1Up
    Range("A1:C3").Selection
    Selection.Delete Shift:=x1Up
End Sub

В этом вопросе ( Импорт нескольких текстовых файлов в Excel ) естьответ, но мне нужно изменить имя файла только в пути, потому что имена файлов будут получены из другого столбца Excel.В Google и Stackoveflow я ничего не нашел.

Answer 1

Создайте переменную, которая будет хранить путь к файлам.Если вы возьмете «открывающий код» в if, вы можете открыть любой файл по своему желанию (если имена файлов указаны в первом столбце в Excel).

Sub openfile()

    Dim Con As String

    For i = 3 To 400

    Con = "TEXT;" & Cells(1,4).Value & "\" & Cells(i,1).Value

    With ActiveSheet.QueryTables.Add(Connection:= _
        Con _
        ,Destination:=Cells(i,2)
        .Name = Cells(i,1).Value
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    Next i

End Sub

Answer 2

1. Запишите пути в Range("A1:A5") и выполните их цикл, передавая их в качестве параметра Sub OpenFile.

2. Затем в вашем коде изменитеC:\Users\HarrsionDavid\Desktop\\source к переданному параметру.

3. Попытайтесь улучшить свой код, стараясь избегать Select и Activate - Как избежать использования Select в Excel VBA:

---

Option Explicit

Public Sub TestMe()

    Dim paths As Variant        
    paths = Range("A1:A5")
    Dim singlePath As Variant

    For Each singlePath In paths
        OpenFile (singlePath)
    Next singlePath

End Sub

Public Sub OpenFile(singlePath As String)

    With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & singlePath, Destination:=Range("A1"))
        'more code...
    End With

End Sub

Answer 3

Вставьте другой код, чтобы создать базовый цикл, и измените одну строку в текущем коде, как показано ниже:

Public Path As String
Public rng As Range
Sub Loop_Through_Files()
'ensure that public path is the first line in this module literally at the very top
'set this as your first set of data
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1")
Repeat:
Path = rng.Value
Call openfile
Set rng = rng.Offset(1, 0)
If IsEmpty(rng.Value) Then ' checks if the cell is blank and ends macro, ensure that after the last path there is a blank cell
Else
GoTo Repeat
End If
End Sub

Это ваш код, слегка измененный, я заменил ваш путь на слово path.

Sub openfile()
'ensure that public path is the first line in this module literally at the very top
  With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Path _
        , Destination:=Range("A1"))
        .Name = "customer.txt"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1250
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 9, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
  End With

  Range("A1:C3").Selection
  Selection.delete Shift:=x1Up
  Range("A1:C3").Selection
  Selection.delete Shift:=x1Up

End Sub

Answer 4

Вы можете использовать строковую переменную для имени файла и добавить ее к жестко закодированному пути к файлу:

Sub openfile(ByVal sFileName As String)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\HarrsionDavid\Desktop\\source\" & sFileName, _
        Destination:=Range("A1"))
        .Name = "customer.txt"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1250
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 9, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A1:C3").Selection
    Selection.Delete Shift:=xlUp
    Range("A1:C3").Selection
    Selection.Delete Shift:=xlUp
End Sub

Затем вызвать, передав имя файла:

Sub TestOpenFile()
    openfile "customer.txt"
End Sub