从文本文件导入到Excel

我正在尝试编写一个VBAmacros,它将提示用户在运行后立即select一个目录。

一旦用户select一个目录,macros将扫描其中的所有*.txt文件,并将其每个内容放在G列下的新行中。 因此,第一个文本文件的内容将在G2 ,第二个文本文件在G3等等。

我浏览了很久的StackOverFlow并find了一个可用的代码

 Function GetFolder() As String Dim fldr As FileDialog Dim sItem As String Set fldr = Application.FileDialog(msoFileDialogFolderPicker) With fldr .Title = "Select a Folder" .AllowMultiSelect = False .InitialFileName = Application.DefaultFilePath If .Show <> -1 Then GoTo NextCode sItem = .SelectedItems(1) End With NextCode: GetFolder = sItem Set fldr = Nothing End Function 

我也做了一些很差的硬编码,只导入一个文本文件到G2单元

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

我不知道如何把这些碎片放在一起,有一个工作代码。

  1. 阅读我select的目录内的所有txt文件。
  2. 将每个文本文件内容放在同一工作表( G2G3等)的新行中

这些文本文件中的每一个都只有一行或两行数据,不希望在那里分隔任何内容。 只需复制txt文件中的大量文本,并将其粘贴到G2 ,直到完成所选目录中的所有txt文件。

  1. 读取目录中的所有txt文件或select一个文件

下面的代码应该让你select一个或多个你想要导入的文件

Application.FileDialog属性(Excel)

  '// Open Dailog With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True <-- Allow multiple selection .Show '<-- display the files End With 
  1. 设置数据的行号从G2开始,然后是下一个

如果需要更新下面的代码

 nRow = Range("G2").End(xlUp).Offset(1, 0).row Destination:=Range("$G$" & nRow)) 

请参阅完整的注释代码

 Sub Import() '// Declare a variable as Dim nRow As Long Dim sExtension As String Dim oFolder As FileDialog '// FileDialog object Dim vSelectedItem As Variant '// Stop Screen Flickering Application.ScreenUpdating = False '// Create a FileDialog object as a File Picker dialog box Set oFolder = Application.FileDialog(msoFileDialogOpen) '// Use a With...End With block to reference FileDialog. With oFolder '// Allow multiple selection. .AllowMultiSelect = True '// Use the Show method to display the files. If .Show = -1 Then '// Extension sExtension = Dir("*.txt") '// Step through each SelectedItems For Each vSelectedItem In .SelectedItems '// Sets Row Number for Data to Begin nRow = Range("G2").End(xlUp).Offset(1, 0).row '// Below is importing a text file With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & sExtension, Destination:=Range("$G$" & nRow)) .Name = sExtension .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 850 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = True .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = True .TextFileOtherDelimiter = "=" .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With sExtension = Dir Next '// If Cancel... Else End If End With Application.ScreenUpdating = True '// Set object to Nothing. Object? see Link Object Set oFolder = Nothing End Sub 

设置对象=没有