在 VBA 中附加 TXT 文件并在 Excel 中打开

Question

这里是新手。

所以我有十几个类似这样的 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

任何帮助将不胜感激。

Answer 1

MyFile = Dir(MyFolder) 仅返回MyFile 中的文件名，因此打开第一个文件使用Workbooks.Open (MyFolder & MyFile)。打开文本文件时，工作表名称是文件名，因此Workbooks(MyFile).Worksheets("Sheet1") 需要为Workbooks(MyFile).sheets(1)。因为您的文本文件只有第 1 行的 A 列中的数据Selection.End(xlToRight) 将进入工作表的最后一列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