Question

我想将多个TXT文件导入excel（在同一张表中 - 每个文件只有6行）。如何在每个周期中更改文件路径（我将在for循环中进行）？

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

在这个问题（Import multiple text files into excel）中有答案，但我只需要在路径中更改文件名，因为文件名将来自其他excel列。在谷歌和Stackoveflow上我找不到任何东西。

Answer 1

您可以将字符串变量用于文件名，并将其附加到硬编码文件路径：

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

Answer 2

在Range("A1:A5")中写下路径并循环浏览它们，将它们作为参数传递给Sub OpenFile。
然后在您的代码中将C:\Users\HarrsionDavid\Desktop\\source更改为传递的参数。
尝试避免Select和Activate - How to avoid using Select in 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

这是您稍微修改过的代码，我用路径替换了您的路径。

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

创建一个存储文件路径的变量。如果你把它打开＆＃34;打开代码＆＃34;在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

如何动态更改文件路径中的文件名？

4 个答案: