Import Multiple text files into workbook where worksheet name matches text file name

后端 未结 1 700
醉酒成梦
醉酒成梦 2021-01-19 12:55

Introduction: With continuation to my previous question, initially, my previous code (with the help from Stack exchange experts) works fine.

1条回答
  •  清酒与你
    2021-01-19 13:01

    Consider using QueryTables to import text files. No need to copy/paste across temp workbooks:

    Sub ImportTXTFiles()
        Dim fso As Object
        Dim xlsheet As Worksheet
        Dim qt As QueryTable
        Dim txtfilesToOpen As Variant, txtfile As Variant
    
        Application.ScreenUpdating = False
        Set fso = CreateObject("Scripting.FileSystemObject")
    
        txtfilesToOpen = Application.GetOpenFilename _
                     (FileFilter:="Text Files (*.txt), *.txt", _
                      MultiSelect:=True, Title:="Text Files to Open")    
    
        For Each txtfile In txtfilesToOpen
            ' FINDS EXISTING WORKSHEET
            For Each xlsheet In ThisWorkbook.Worksheets
                If xlsheet.Name = Replace(fso.GetFileName(txtfile), ".txt", "") Then
                    xlsheet.Activate
                    GoTo ImportData
                End If
            Next xlsheet
    
            ' CREATES NEW WORKSHEET IF NOT FOUND
            Set xlsheet = ThisWorkbook.Worksheets.Add( _
                                 After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            xlsheet.Name = Replace(fso.GetFileName(txtfile), ".txt", "")
            xlsheet.Activate
            GoTo ImportData
    
    ImportData:
            ' DELETE EXISTING DATA
            ActiveSheet.Range("A:Z").EntireColumn.Delete xlShiftToLeft
    
            ' IMPORT DATA FROM TEXT FILE
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & txtfile, _
              Destination:=ActiveSheet.Cells(1, 1))
                .TextFileParseType = xlDelimited
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileOtherDelimiter = "|"
    
                .Refresh BackgroundQuery:=False
            End With
    
            For Each qt In ActiveSheet.QueryTables
                qt.Delete
            Next qt
        Next txtfile
    
        Application.ScreenUpdating = True
        MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"
    
        Set fso = Nothing
    End Sub
    

    0 讨论(0)
提交回复
热议问题