ขออนุญาตสอบถามเรื่องการนำเข้า Text file กรณีนำเข้าไฟล์แล้วเกิดปัญหาชื่อ sheet ที่เป็นภาษาอังกฤษตัวเล็กกับตัวใหญ่ครับ
กรณีที่ชื่อ sheet เป็นตัวเล็กและชื่อ text ไฟล์ที่นำเข้าเป็นตัวเล็ก สามารถนำเข้าได้ตรงกับ sheet ครับ แต่ถ้าชื่อไฟล์ที่นำเข้าเป็นตัวใหญ่จะนำเข้าไม่ตรงกับชื่อ sheet แต่เป็นการแทรก sheet ใหม่
Code: Select all
Sub ImportTXTFiles()
Dim fso As Object
Dim xlsheet As Worksheet
Dim qt As QueryTable
Dim txtfilesToOpen As Variant, txtfile As Variant
On Error Resume Next
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
txtfilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, Title:="เลือกไฟล์ที่ต้องการนำเข้า")
If VarType(txtfilesToOpen) = vbBoolean Then
MsgBox "กรุณเลือกไฟล์ที่จะนำเข้า"
Exit Sub
End If
For Each txtfile In txtfilesToOpen
' ทำหน้าที่หา sheet ที่ต้องการ
For Each xlsheet In ThisWorkbook.Worksheets
If xlsheet.Name = Replace(fso.GetFileName(txtfile), ".txt", "") Then
xlsheet.Activate
GoTo ImportData
End If
Next xlsheet
' สร้าง sheet ใหม่ ถ้าไม่พบ sheet ที่ต้องการ
Set xlsheet = ThisWorkbook.Worksheets.Add( _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
xlsheet.Name = Replace(fso.GetFileName(txtfile), ".txt", "")
xlsheet.Activate
GoTo ImportData
ImportData:
' ลบข้อมูลเก่าทิ้ง
ActiveSheet.Range("A:Z").EntireColumn.Delete xlShiftToLeft
' นำเข้าข้อมูลจาก text ไฟล์
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & txtfile, _
Destination:=ActiveSheet.Cells(3, 1))
.Name = "DataSheet"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.AdjustColumnWidth = True
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2) ' จำนวน column ที่ต้องการให้มีตัวกรอง
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Range("A3").AutoFilter Field:=1, Visibledropdown:=True
ActiveSheet.Range("A3").AutoFilter Field:=2, Visibledropdown:=True
Application.ErrorCheckingOptions.NumberAsText = False
Cells.Select
Selection.NumberFormat = "0"
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next qt
Next txtfile
Application.ScreenUpdating = True
MsgBox "นำเข้าข้อมูลสำเร็จแล้ว", vbInformation, "สำเร็จแล้ว"
' Sheets("F43Import").activate 'หลังจากนำเข้าเสร็จแล้วให้ไปทำงานที่ sheet แรก
Sheets(1).Activate ' ให้ทำงานที่ sheetแรกอัตโนมัติ
Set fso = Nothing
On Error Resume Next
For Each sht In ThisWorkbook.Worksheets
xlsheet.Cells.SpecialCells(xlCellTypeVisible).EntireColumn.AutoFit
Next sht
On Error GoTo 0
End Sub
รบกวนแนะนำวิธีแก้ไขด้วยครับ ขอบพระคุณครับ
You do not have the required permissions to view the files attached to this post.
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
