如何动态更改文件路径中的文件名?
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
在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
插入另一段代码以创建一个基本循环,并按照以下内容更改当前代码中的一行:
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
我想将多个 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
在
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
插入另一段代码以创建一个基本循环,并按照以下内容更改当前代码中的一行:
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