问题描述
一旦用户选择了一个目录,宏将会扫描其中的所有 *。txt
文件,并将其每个内容放在 G
列之前的新行中。所以,第一个文本文件的内容将在 G2
中, G3
中的第二个文本文件等等。 p>
我浏览了StackOverFlow很长时间,找到了一个工作代码
Function GetFolder )As String
Dim fldr As FileDialog
Dim sItem As String
设置fldr = Application.FileDialog(msoFileDialogFolderPicker)
使用fldr
.Title =选择文件夹
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
如果.Show<> -1然后GoTo NextCode
sItem = .SelectedItems(1)
结束
NextCode:
GetFolder = sItem
设置fldr = Nothing
结束函数
我还做了一些非常差的硬编码,只将一个文本文件导入单元格 G2
使用ActiveSheet.QueryTables.Add(Connection:= _
TEXT ; D:\K\record001_001.txt_
,目的地:=范围($ 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
我不知道如何将这些片段放在一起,以便有一个可以工作的代码。
- 读取我选择的目录中的所有
txt
文件。 - 将每个文本文件内容放在相同工作表的新行(
G2
,G3
等) - Read all the
txt
files inside the directory I choose. - Put each of the text files content in a new row of the same worksheet (
G2
,G3
, etc.)
每个文本文件只有一行或两行数据,不需要在那里分隔任何内容。只需复制 txt
文件中的大量文本,并将其粘贴到 G2
中,直到所有<$选择目录中的c $ c> txt 文件。
以下代码应允许您选择要导入的一个或多个文件
'//打开Dailog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True< - 允许多个选择
。显示'< - 显示文件
结束
如果需要更新以下代码
nRow = Range G2)。End(xlUp).Offset(1,0).row
Destination:= Range($ G $& nRow))
查看完整的与评论
Sub Import()
'//声明一个变量
Dim nRow As Long
Dim sExtension As String
Dim oFolder As FileDialog'// FileDialog object
Dim vSelectedItem As Variant
'//停止屏幕闪烁
Application.ScreenUpdating = False
'//创建FileDialog对象作为文件选择器对话框
设置oFolder = Application.FileDialog( msoFileDialogOpen)
'//使用With ... End With块引用FileDialog。
带oFolder
'//允许多选。
.AllowMultiSelect = True
'//使用Show方法显示文件。
如果.Show = -1然后
'//扩展
sExtension = Dir(*。txt)
'//逐步每个SelectedItems
对于每个vSelectedItem在.SelectedItems
'//设置数据开始的行号
nRow =范围(G2)。End(xlUp).Offset 1,0).row
'//以下是导入文本文件
使用ActiveSheet.QueryTables.Add(Connection:= _
TEXT;& sExtension,目的地:=范围($ G $& nRow))
.Name = sExtension
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
。 RefreshPeriod = 0
.TextFilePromptOn Refresh = 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
结束
sExtension = Dir
下一个
'//如果取消...
Else
如果
结束
Application.ScreenUpdating = True
'//将对象设置为Nothing。目的?请参阅链接对象
设置oFolder = Nothing
End Sub
I am trying to write a VBA macro that will prompt the user to choose a directory immediately after running it.
Once the user chooses a directory, the macro will scan through all the *.txt
files in it and put each of its contents in new row under column G
. So, the contents of 1st text file will be in G2
, second text file in G3
and so on.
I browsed StackOverFlow for long and found a working code
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
I also did some very poor hard-coding to import just one text file into cell 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
I do not know how to put these pieces together to have a working code that will.
Each of those text files have just one or two rows of data and do not want anything to be delimited there. Just copy the whole lot of text in the txt
file and paste it in G2
, in a loop until all txt
files in the selected directory are done.
The following code should let you choose one or multiple files you want to Import
Application.FileDialog Property (Excel)
'// Open Dailog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True <-- Allow multiple selection
.Show '<-- display the files
End With
If need update the following code
nRow = Range("G2").End(xlUp).Offset(1, 0).row
Destination:=Range("$G$" & nRow))
See complete with comments
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
这篇关于从文本文件导入到Excel的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!