ไปยังเนื้อหาหลัก

วิธีการนำเข้าไฟล์ข้อความหลายไฟล์จากโฟลเดอร์ลงในแผ่นงานเดียว

สำหรับอินสแตนซ์ที่นี่คุณมีโฟลเดอร์ที่มีไฟล์ข้อความหลายไฟล์สิ่งที่คุณต้องการทำคือการนำเข้าไฟล์ข้อความเหล่านี้ลงในแผ่นงานเดียวดังภาพหน้าจอด้านล่าง แทนที่จะคัดลอกไฟล์ข้อความทีละไฟล์มีเคล็ดลับในการนำเข้าไฟล์ข้อความจากโฟลเดอร์หนึ่งไปยังแผ่นเดียวอย่างรวดเร็วหรือไม่?

นำเข้าไฟล์ข้อความหลายไฟล์จากโฟลเดอร์เดียวลงในแผ่นงานเดียวด้วย VBA

นำเข้าไฟล์ข้อความไปยังเซลล์ที่ใช้งานอยู่ด้วย Kutools for Excel ความคิดที่ดี 3


นี่คือรหัส VBA สามารถช่วยคุณนำเข้าไฟล์ข้อความทั้งหมดจากโฟลเดอร์เฉพาะไปยังแผ่นงานใหม่

1. เปิดใช้งานสมุดงานที่คุณต้องการนำเข้าไฟล์ข้อความแล้วกด Alt + F11 คีย์เพื่อเปิดใช้งาน Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

2 คลิก สิ่งที่ใส่เข้าไป > โมดูลคัดลอกและวางโค้ด VBA ด้านล่างลงในไฟล์ โมดูล หน้าต่าง

VBA: นำเข้าไฟล์ข้อความหลายไฟล์จากโฟลเดอร์หนึ่งไปยังแผ่นเดียว

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    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
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

3 กด F5 เพื่อแสดงกล่องโต้ตอบและเลือกโฟลเดอร์ที่มีไฟล์ข้อความที่คุณต้องการนำเข้า ดูภาพหน้าจอ:
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 1

4 คลิก OK. จากนั้นไฟล์ข้อความจะถูกนำเข้าสู่สมุดงานที่ใช้งานเป็นแผ่นงานใหม่แยกกัน
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 2


หากคุณต้องการนำเข้าไฟล์ข้อความหนึ่งไฟล์ไปยังเซลล์หรือช่วงที่ต้องการคุณสามารถสมัครได้ Kutools สำหรับ Excel's แทรกไฟล์ที่เคอร์เซอร์ ประโยชน์

Kutools สำหรับ Excel, ที่มีมากกว่า 300 ฟังก์ชั่นที่มีประโยชน์ทำให้งานของคุณง่ายขึ้น 

หลังจาก ติดตั้งฟรี Kutools สำหรับ Excel โปรดทำดังนี้:

1. เลือกเซลล์ที่คุณต้องการนำเข้าไฟล์ข้อความแล้วคลิก Kutools พลัส > นำเข้าส่งออก > แทรกไฟล์ที่เคอร์เซอร์. ดูภาพหน้าจอ:
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 3

2. จากนั้นกล่องโต้ตอบจะปรากฏขึ้นให้คลิก หมวดหมู่สินค้า เพื่อแสดง เลือกไฟล์ ที่จะแทรกที่กล่องโต้ตอบตำแหน่งเคอร์เซอร์ของเซลล์ให้เลือกถัดไป ไฟล์ข้อความ จากรายการแบบหล่นลงจากนั้นเลือกไฟล์ข้อความที่คุณต้องการนำเข้า ดูภาพหน้าจอ:
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 4

3 คลิก จุดเปิด > Okและไฟล์ข้อความระบุถูกแทรกที่ตำแหน่งเคอร์เซอร์ดูภาพหน้าจอ:
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 5

สุดยอดเครื่องมือเพิ่มผลผลิตในสำนักงาน

คุณสมบัติยอดนิยม: ค้นหา เน้น หรือระบุรายการที่ซ้ำกัน   |  ลบแถวว่าง   |  รวมคอลัมน์หรือเซลล์โดยไม่สูญเสียข้อมูล   |   รอบโดยไม่มีสูตร ...
การค้นหาขั้นสูง: VLookup หลายเกณฑ์    VLookup หลายค่า  |   VLookup ข้ามหลายแผ่น   |   การค้นหาที่ไม่ชัดเจน ....
รายการแบบเลื่อนลงขั้นสูง: สร้างรายการแบบหล่นลงอย่างรวดเร็ว   |  รายการแบบหล่นลงขึ้นอยู่กับ   |  เลือกหลายรายการแบบหล่นลง ....
ผู้จัดการคอลัมน์: เพิ่มจำนวนคอลัมน์เฉพาะ  |  ย้ายคอลัมน์  |  สลับสถานะการมองเห็นของคอลัมน์ที่ซ่อนอยู่  |  เปรียบเทียบช่วงและคอลัมน์ ...
คุณสมบัติเด่น: กริดโฟกัส   |  มุมมองการออกแบบ   |   บาร์สูตรใหญ่    สมุดงานและตัวจัดการชีต   |  ห้องสมุดทรัพยากร (ข้อความอัตโนมัติ)   |  เลือกวันที่   |  รวมแผ่นงาน   |  เข้ารหัส/ถอดรหัสเซลล์    ส่งอีเมลตามรายการ   |  ซุปเปอร์ฟิลเตอร์   |   ตัวกรองพิเศษ (กรองตัวหนา/ตัวเอียง/ขีดทับ...) ...
ชุดเครื่องมือ 15 อันดับแรก12 ข้อความ เครื่องมือ (เพิ่มข้อความ, ลบอักขระ, ... )   |   50 + แผนภูมิ ประเภท (แผนภูมิ Gantt, ... )   |   40+ ใช้งานได้จริง สูตร (คำนวณอายุตามวันเกิด, ... )   |   19 การแทรก เครื่องมือ (ใส่ QR Code, แทรกรูปภาพจากเส้นทาง, ... )   |   12 การแปลง เครื่องมือ (ตัวเลขเป็นคำ, การแปลงสกุลเงิน, ... )   |   7 ผสานและแยก เครื่องมือ (แถวรวมขั้นสูง, แยกเซลล์, ... )   |   ... และอื่น ๆ

เพิ่มพูนทักษะ Excel ของคุณด้วย Kutools สำหรับ Excel และสัมผัสประสิทธิภาพอย่างที่ไม่เคยมีมาก่อน Kutools สำหรับ Excel เสนอคุณสมบัติขั้นสูงมากกว่า 300 รายการเพื่อเพิ่มประสิทธิภาพและประหยัดเวลา  คลิกที่นี่เพื่อรับคุณสมบัติที่คุณต้องการมากที่สุด...

kte แท็บ 201905


แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มประสิทธิภาพการทำงานของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
Comments (46)
Rated 4 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
the below code can split data into columns based on space or tab while importing text file to sheets. But I don't want a separate tab for each txt file i would like them all under once sheet. The information is the same format for each file. . What can be modified to allow this to be all one one sheet instead of each file imported being a new tab any and all help would be appreciated

Sub ImportTextToExcel()
'UpdatebyExtendoffice20180911
Dim xWb As Workbook
Dim xToBook As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim xFiles As New Collection
Dim I As Long
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue As String
Dim xRg As Range
Dim xArr
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
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Then
MsgBox "No files found", vbInformation, "Kutools for Excel"
Exit Sub
End If
Do While xFile <> ""
xFiles.Add xFile, xFile
xFile = Dir()
Loop
Set xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = False
If xFiles.Count > 0 Then

For I = 1 To xFiles.Count
Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
For xFNum = 1 To xIntRow
Set xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
If UBound(xArr) > 0 Then
For xFArr = 0 To UBound(xArr)
If xArr(xFArr) <> "" Then
xRg.Value = xArr(xFArr)
Set xRg = xRg.Offset(ColumnOffset:=1)
End If
Next
End If
Next
Next
End If
Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
Hi, Daniel, try below code, it import all text files in one sheet named Txt.
Notice that: if the text name is the same with the exisited sheet name, the text file may be not imported.
Sub ImportTextToExcel2()

'UpdatebyExtendoffice20230106

Dim xWb As Workbook

Dim xToBook As Workbook

Dim xStrPath As String

Dim xFileDialog As FileDialog

Dim xFile As String

Dim xFiles As New Collection

Dim I As Long

Dim xIntRow As Long

Dim xFNum, xFArr As Long

Dim xStrValue As String

Dim xRg As Range

Dim xArr

Dim xRowL, xRowH As Integer

Dim xTxtWS, xWSD As Worksheet

Dim xTxtWS_Rg As Range

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

If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"

xFile = Dir(xStrPath & "*.txt")

If xFile = "" Then

MsgBox "No files found", vbInformation, "Kutools for Excel"

Exit Sub

End If

Do While xFile <> ""

xFiles.Add xFile, xFile

xFile = Dir()

Loop

Set xToBook = ThisWorkbook

On Error Resume Next

Set xTxtWS = xToBook.Worksheets("Txt")

If IsNull(xTxtWS) Or IsEmpty(xTxtWS) Then

    Set xTxtWS = xToBook.Worksheets.Add

    xTxtWS.Name = "Txt"

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xTxtWS.Activate

If xFiles.Count > 0 Then

xRowL = 1

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

Set xWSD = xToBook.Sheets(xToBook.Sheets.Count)

xTxtWS.Activate

xWb.Close False

xIntRow = xWSD.UsedRange.CurrentRegion.Rows.Count

    For xFNum = 1 To xIntRow

        Set xRg = xWSD.Range("A" & xFNum)

        xArr = Split(xRg.Text, " ")

        Set xTxtWS_Rg = xTxtWS.Cells.Range("A" & xRowL)

'        If UBound(xArr) > 0 Then

            For xFArr = 0 To UBound(xArr)

                If xArr(xFArr) <> "" Then

                xTxtWS_Rg.Value = xArr(xFArr)

                Set xTxtWS_Rg = xTxtWS_Rg.Offset(ColumnOffset:=1)

                End If

            Next

'        End If

xRowL = xRowL + 1

    Next

xWSD.Delete

Next

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub


This comment was minimized by the moderator on the site
This works fine. But when it imports it renames sheets with name.txt how to make it keep only name without adding .txt extension to the sheet?
Rated 3.5 out of 5
This comment was minimized by the moderator on the site
Ok nvm found answer with google help.
replace line:
ActiveSheet.Name = xWb.Name
with:
ActiveSheet.Name = Left(xWb.Name,Len(xWb.Name)-4)
would remove last 4 letters from sheet name. Effectively giving me what i needed. name without .txt
Cheers
Rated 4 out of 5
This comment was minimized by the moderator on the site
Hi, thanks for your valuable VBA code.
However, I need a code for multiple txt files into 'a single sheet in the worksheet, not an individual sheet for each txt file'.
What should I edit your code for my purpose?

Thanks,
This comment was minimized by the moderator on the site
Hi, please try below code
Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    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
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
This comment was minimized by the moderator on the site
In the below code if i want to specify the folder rather than selecting the path everytime import a text file , what modification have have to do

VBA CODE:

Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
Dim xSht As Worksheet
Dim xWb As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
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
Set xSht = ThisWorkbook.ActiveSheet
If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.txt")
Do While xFile <> ""
Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close False
xFile = Dir
Loop
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "no txt files", , "Kutools for Excel"
End Sub
This comment was minimized by the moderator on the site
Hi, please try below code
Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    xStrPath = "C:\Users\AddinsVM001\Desktop\test" 'Here is the parth you can modify
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

"C:\Users\AddinsVM001\Desktop\test" is the folder path you may import text file from, please change it as you need.
This comment was minimized by the moderator on the site
The code works but imports each text file to a new tab in the workbook. Any idea where in the code this could be changed to import the new text file on the same worksheet below the data from the last text file?
This comment was minimized by the moderator on the site
i need you help i dont have any idea vba excel i want to import multiple text file like 13000. the text file name same as the cell for example (c1=112 so the text file name is also 112) mean the text file 112 is import the c112.
This comment was minimized by the moderator on the site
0

i need you help i dont have any idea vba excel i want to import multiple text file like 13000. the text file name same as the cell for example (c1=112 so the text file name is also 112) mean the text file 112 is import the c112.
This comment was minimized by the moderator on the site
Hi, my code runs but only imports the first file. It says there was a method error for copy. The debugger highlights the following line of code. Any ideas?


xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
This comment was minimized by the moderator on the site
Hey Martinho,
I had the same Problem and solved it by changing this line:
Set xToBook = ThisWorkbook
to
Set xToBook = ActiveWorkbook
Maybe this helps.
This comment was minimized by the moderator on the site
thanks a lotdid the job on office 2007 excel
This comment was minimized by the moderator on the site
is there any chance for taking sheet names only certain part from txt file names?

as per above code the entire sheet name has been taking.
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations