Metin dosyalarını Excel'de orijinal adlarla ayrı sayfalar olarak Excel'e nasıl aktarabilirim?

Excel'de dosyaların orijinal adlarıyla birlikte metin dosyalarını ayrı sayfalar olarak Excel'e aktarmayı hiç denediniz mi? Bu makalede, metin dosyalarını bir klasörden Excel'e adlarla hızlı bir şekilde içe aktarmak için bir VBA kodu tanıtıyorum.

Metin dosyalarını adlarla Excel'e aktarın

---

Metin dosyalarını adlarla Excel'e aktarın

1. Excel'i etkinleştirin, Alt + F11 etkinleştirmek için anahtarlar Uygulamalar için Microsoft Visual Basic pencere, ardından tıklayın Ekle > modül.

2. Aşağıdaki kodu kopyalayıp şuraya yapıştırın: modül komut.

VBA: Metin dosyalarını adlarla içe aktarın

Sub LoadPipeDelimitedFiles()
'UpdatebyExtendoffice20181010
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long
    Dim xWS As Worksheet
    
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\*.txt")
    Do While xFile <> ""
        xCount = xCount + 1
        Set xWS = Sheets(xCount)
        xWS.Select
        xWS.Name = "TEXT " & Left(xFile, Len(xFile) - 4)
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
          & xStrPath & "\" & xFile, Destination:=Range("A1"))
            .Name = "a" & xCount
            .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
            .TextFileOtherDelimiter = "|"
            .TextFileColumnDataTypes = Array(1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
            xFile = Dir
        End With
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no files txt", , "Kutools for Excel"
End Sub

3. Basın F5 kodu çalıştırmak için, ardından Excel'e aktarmak istediğiniz metin dosyalarını içeren bir klasörü seçin. Bir klasör seçin iletişim.

4. tık OKklasördeki metin dosyaları kendi adlarıyla tek bir sayfa olarak Excel'e aktarılmıştır.