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

How can I change dynamicly the file name in the file path?

我想将多个 TXT 文件导入 excel(导入同一个 sheet - 每个文件只有 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列中获取。在 Google 和 Stackoveflow 上我没有找到任何东西。

您可以使用字符串变量作为文件名,并将其附加到硬编码文件路径中:

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
  1. Range("A1:A5")中写入路径并循环遍历它们,将它们作为参数传递给Sub OpenFile

  2. 然后在您的代码中将 C:\Users\HarrsionDavid\Desktop\source 更改为传递的参数。

  3. 尝试通过避免 SelectActivate - How to avoid using Select in Excel VBA:

  4. 来改进您的代码

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

插入另一段代码以创建一个基本循环,并按照以下内容更改当前代码中的一行:

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

创建一个变量来存储文件的路径。如果你把它放在 if 中的 "opening code" 你可以打开你想要的每个文件(如果文件名在 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