Question

从多个TXt文件导入数据到excel中，如何修改VBA代码，选取不同的文件

我用录制宏的办法，录了一个宏，但是这个宏里面的代码开头读取文件的地方是我录的时候那个文件，此外还有很多文件呢，怎么能够把其他的文件也录进去，就是选取文件或者一次就能按先后顺序录进去，文件名都是ap1932.txt 后面的是ap1933一直到ap2010，要求这些数据排在一个excel表里，代码如下，如何修改

Sub 导入数据()
'
' 导入数据 Macro
' 宏由 admin 录制，时间: 2011-11-25
'

'
With ActiveSheet.QueryTables.Add(Connection:="TEXT;D:\data\ap1932.txt", _
Destination:=Range("A1"))
.Name = "ap1932"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Answer 1

Public Sub dbhb()
Dim FilesToOpen
Dim x As Integer
'Sheets.Add.Name = "空表"

On Error GoTo ErrHandler
Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="MicroSoft Excel文件(*.txt),*.txt", _
MultiSelect:=True, Title:="要合并的文件")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "没有选中文件"
GoTo ExitHandler
End If

x = 1
u = 1
While x <= UBound(FilesToOpen)
cd = 1
lj = FilesToOpen(x)
33
If InStr(Right(FilesToOpen(x), cd), "\") Then
GoTo 44
Else
cd = cd + 1
GoTo 33
End If
44

mz = Mid(FilesToOpen(x), (Len(FilesToOpen(x)) - cd + 2), cd - 5) & u

sr = "TEXT;" & lj
With ActiveSheet.QueryTables.Add(Connection:=sr, _
Destination:=Range("A" & u))
.Name = mz
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

x = x + 1
u = Range("A1").End(xlDown).Row

Wend

ExitHandler:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
将多个TXT文件导入到一个工作表里。
能直接打开对话框让你选TXT取文件，不足之处在于你选择的第一个文件将在最后导入。

Answer 2

用DIR函数，详见VBA帮助中的此函数