كيفية استيراد ملفات نصية إلى Excel كأوراق منفصلة بأسماء أصلية في Excel؟

هل سبق لك أن حاولت استيراد ملفات نصية إلى Excel كأوراق منفصلة بأسماء الملفات الأصلية في Excel؟ في هذه المقالة ، أقدم رمز VBA لاستيراد الملفات النصية بسرعة من مجلد واحد إلى Excel مع الأسماء.

استيراد ملفات نصية إلى Excel بأسماء

---

استيراد ملفات نصية إلى Excel بأسماء

1. قم بتمكين Excel ، اضغط على ALT + F11 مفاتيح للتمكين ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، ثم انقر فوق إدراج > وحدة.

2. انسخ والصق الكود أدناه إلى وحدة النصي.

فبا: استيراد ملفات نصية بأسماء

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. صحافة F5 لتشغيل الكود ، ثم حدد مجلدًا يحتوي على ملفات نصية تريد استيرادها إلى Excel بتنسيق حدد مجلدًا الحوار.

4. انقر OK، تم استيراد الملفات النصية في المجلد في Excel على هيئة ورقة مفردة بأسمائها الخاصة.