在 VBA 中附加 TXT 文件并在 Excel 中打开
Appending TXT files in VBA and opening in Excel
这里是新手。
所以我有很多这样的 TXT/DTA 文件,我想将它们并排堆叠。 我想把每个文件都追加到右边,合并成一个大文件
不太了解 VBA 我环顾四周并合并了一些代码,这些代码似乎适用于 xlsx 文件,但不适用于我所拥有的 DTA 文件。该代码要求一个文件夹并一个一个地循环文件。
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbk As Workbook 'Used to loop through each workbook
On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
'---Open the first file only
Workbooks.Open (MyFile)
Workbooks(MyFile).Worksheets("Sheet1").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Workbooks("CV Combined.xlsm").Worksheets("Sheet1").Range("A1")
Workbooks(MyFile).Close SaveChanges:=False
MyFile = Dir
Do While MyFile <> ""
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(fileName:=MyFolder & MyFile)
'Replace the line below with the statements you would want your macro to perform
Workbooks.Open (MyFile)
Workbooks(MyFile).Worksheets("Sheet1").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Workbooks("CV Combined.xlsm").Worksheets("Sheet1").Range("A1").End(xlToRight).Offset(0, 1)
Workbooks(MyFile).Close SaveChanges:=False
wbk.Close SaveChanges:=True
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
End Sub
如有任何帮助,我们将不胜感激。
MyFile = Dir(MyFolder)
returns 只有 MyFile
中的文件名所以要打开第一个文件使用 Workbooks.Open (MyFolder & MyFile)
。当打开文本文件时,sheet 名称是文件名,因此 Workbooks(MyFile).Worksheets("Sheet1")
需要是 Workbooks(MyFile).sheets(1)
。因为您的文本文件只有第 1 行 A 列中的数据 Selection.End(xlToRight)
将转到 sheet 的最后一列 XFD1
然后 Selection.End(xlDown)
将转到最后一行 XFD1048576
.
Option Explicit
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbDTA As Workbook 'Used to loop through each workbook
Dim ws As Worksheet, wsDTA As Worksheet, rng As Range
Dim iCol As Long, n As Long
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
Set ws = Workbooks("CV Combined.xlsm").Sheets(1)
iCol = 1
'Loop through all files in a folder until DIR cannot find anymore
Application.ScreenUpdating = False
MyFile = Dir(MyFolder)
Do While MyFile <> ""
Set wbDTA = Workbooks.Open(MyFolder & MyFile, False, False)
Set wsDTA = wbDTA.Sheets(1)
Set rng = wsDTA.UsedRange
rng.Copy ws.Cells(1, iCol)
iCol = iCol + rng.Columns.Count + 1 ' add blank column
n = n + 1
wbDTA.Close SaveChanges:=False
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
MsgBox n & " files imported from " & MyFolder, vbInformation
End Sub
这里是新手。
所以我有很多这样的 TXT/DTA 文件,我想将它们并排堆叠。 我想把每个文件都追加到右边,合并成一个大文件
不太了解 VBA 我环顾四周并合并了一些代码,这些代码似乎适用于 xlsx 文件,但不适用于我所拥有的 DTA 文件。该代码要求一个文件夹并一个一个地循环文件。
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbk As Workbook 'Used to loop through each workbook
On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
'---Open the first file only
Workbooks.Open (MyFile)
Workbooks(MyFile).Worksheets("Sheet1").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Workbooks("CV Combined.xlsm").Worksheets("Sheet1").Range("A1")
Workbooks(MyFile).Close SaveChanges:=False
MyFile = Dir
Do While MyFile <> ""
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(fileName:=MyFolder & MyFile)
'Replace the line below with the statements you would want your macro to perform
Workbooks.Open (MyFile)
Workbooks(MyFile).Worksheets("Sheet1").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Workbooks("CV Combined.xlsm").Worksheets("Sheet1").Range("A1").End(xlToRight).Offset(0, 1)
Workbooks(MyFile).Close SaveChanges:=False
wbk.Close SaveChanges:=True
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
End Sub
如有任何帮助,我们将不胜感激。
MyFile = Dir(MyFolder)
returns 只有 MyFile
中的文件名所以要打开第一个文件使用 Workbooks.Open (MyFolder & MyFile)
。当打开文本文件时,sheet 名称是文件名,因此 Workbooks(MyFile).Worksheets("Sheet1")
需要是 Workbooks(MyFile).sheets(1)
。因为您的文本文件只有第 1 行 A 列中的数据 Selection.End(xlToRight)
将转到 sheet 的最后一列 XFD1
然后 Selection.End(xlDown)
将转到最后一行 XFD1048576
.
Option Explicit
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbDTA As Workbook 'Used to loop through each workbook
Dim ws As Worksheet, wsDTA As Worksheet, rng As Range
Dim iCol As Long, n As Long
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
Set ws = Workbooks("CV Combined.xlsm").Sheets(1)
iCol = 1
'Loop through all files in a folder until DIR cannot find anymore
Application.ScreenUpdating = False
MyFile = Dir(MyFolder)
Do While MyFile <> ""
Set wbDTA = Workbooks.Open(MyFolder & MyFile, False, False)
Set wsDTA = wbDTA.Sheets(1)
Set rng = wsDTA.UsedRange
rng.Copy ws.Cells(1, iCol)
iCol = iCol + rng.Columns.Count + 1 ' add blank column
n = n + 1
wbDTA.Close SaveChanges:=False
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
MsgBox n & " files imported from " & MyFolder, vbInformation
End Sub