ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

9KiTTi · #1

ผมนำ macro มาใช้นำเข้าไฟล์ text แต่พอนำเข้ามาแล้วไม่แสดงเป็นภาษาไทย พยายามหาทางจาก google แล้ว ก็ไม่สามารถแก้ไขได้ครับ และวันเดือนปี ก็เป็นชุดตัวเลขตามภาพ ขอความกรุณาแนะนำวิธีแก้ไขด้วยครับ
ขอบพระคุณครับ

ข้อความที่นำเข้าครับ

hospcode|provider|registerno|council|cid|prename|name|lname|sex|birth|providertype|startdate|outdate|movefrom|moveto|d_update
02xxxx|Manxxxx|||1250400201234|004|กล้วยไข|หอมทอง|2|19901001|06|20110401||||20190521111234
0xxx|Nisxxxx|||3251000431234|005|มะม่วง|กระท้อน|2|19631010|084|19991001||||20190312151234
0xxx|Parxxxx|||1259700111234|003|ชะอม|ลำใย|1|19910808|05|20140601|20151130||00219|20190312151234
0xxxx|Raxxxxx |||1130300081234|003|สวัสดี|สวัสดี|1|19930419|04|20190801||01107||20190903081234
0xxxx|rdrugstore_all|||rdrugstore_al|003|รพ.สต.xxxx|rdrugstore_al|1|20041001|09|20041001||||20180411131234
0xxxx|Sanxxxx|||1259700101234|004|สวัสดี|สวัสดี|2|19901214|04|20160501|20190707|02507|02333|20190808101234
0xxxx|Wixxxx|||3250200311234|003|หนุ่มน้อย|สาวสาว|1|19700209|04|19981001||02502||20190312151234
0xxxx|Witcxxxx |พ49110711234|02|3251000441234|005|สาวสาว|สาวสาว|2|19770228|03|20031001||10209||20200110131234

parakorn · #2

แนบไฟล์โค้ด Macro ที่ว่ามาด้วยครับ การ set ภาษาของแต่ล่ะเครื่องไม่เหมือนกัน วิธีแก้ปัญหาแต่ล่ะเครื่องก็อาจจะแตกต่างกันออกไป ต้องลองหลายๆวิธีครับ

9KiTTi · #3

parakorn wrote: Wed Nov 04, 2020 10:54 am แนบไฟล์โค้ด Macro ที่ว่ามาด้วยครับ การ set ภาษาของแต่ล่ะเครื่องไม่เหมือนกัน วิธีแก้ปัญหาแต่ล่ะเครื่องก็อาจจะแตกต่างกันออกไป ต้องลองหลายๆวิธีครับ

ขอโทษครับ ผมใช้ VB ครับ เป็นคำสั่งนำเข้า ผมพิมพ์ผิดครับ

parakorn · #4

9KiTTi wrote: Wed Nov 04, 2020 3:44 pm
parakorn wrote: Wed Nov 04, 2020 10:54 am แนบไฟล์โค้ด Macro ที่ว่ามาด้วยครับ การ set ภาษาของแต่ล่ะเครื่องไม่เหมือนกัน วิธีแก้ปัญหาแต่ล่ะเครื่องก็อาจจะแตกต่างกันออกไป ต้องลองหลายๆวิธีครับ
ขอโทษครับ ผมใช้ VB ครับ เป็นคำสั่งนำเข้า ผมพิมพ์ผิดครับ

ลองแนบไฟล์มาดูตามกฎข้อ 5 ของบอร์ดครับ
เพื่อนๆจะได้ช่วยกันดูใด้ครับ

9KiTTi · #5

ตัว code ที่ผมนำมาใช้ครับ

Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = "|"

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:="|"
x = x + 1

While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
With wkbAll
wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:=sDelimiter
End With
x = x + 1
Wend

ActiveSheet.Range("A1").AutoFilter Field:=1, Visibledropdown:=True
ActiveSheet.Range("A1").AutoFilter Field:=2, Visibledropdown:=True

ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

พอนำเข้าแล้วไม่เป็นภาษาไทย

parakorn · #6

วิธีแนบไฟล์ ให้กดที่ Full Editor & Preview ด้านล่างจะเป็นการเข้าสู่การ Set Up การโพสต์ต่างๆ และ การแนบไฟล์ ครับ

ลองแนบไฟล์ Text ตัดข้อมูลส่วนหนึ่งมาเป็นตัวอย่าง
พร้อมแนบไฟล์ Excel ที่มีโค้ดนี้ เพื่อที่ผู้ที่เข้ามาศึกษา จะได้ทดลองทำได้
และ สะดวกต่อผู้ที่ตอบคำถาม ในการเข้าถึงปัญหาได้ครับ
เท่าที่ดูน่าจะเกิดจากการไม่ Set ค่าภาษาภายในโค้ด ลองแนบไฟล์มาดูก่อนจะได้ปรับโค้ดให้ได้ครับ

ส่วนการโพสต์ โค้ด ให้ดูกฎของบอร์ดข้อที่ 6 ครับ

parakorn · #7

ขอตัวอย่างไฟล์ Text ด้วยครับผม

9KiTTi · #8

parakorn wrote: Thu Nov 05, 2020 4:13 pm ขอตัวอย่างไฟล์ Text ด้วยครับผม

ผมแนบไฟล์ text (txt) ไม่ได้ครับ ระบบแจ้งนามสุกลไม่ถูกต้องครับ

parakorn · #9

9KiTTi wrote: Fri Nov 06, 2020 1:59 pm
parakorn wrote: Thu Nov 05, 2020 4:13 pm ขอตัวอย่างไฟล์ Text ด้วยครับผม
ผมแนบไฟล์ text (txt) ไม่ได้ครับ ระบบแจ้งนามสุกลไม่ถูกต้องครับ

บีบไฟล์ ด้วย win rar ก่อนครับ

9KiTTi · #10

parakorn wrote: Fri Nov 06, 2020 3:16 pm
9KiTTi wrote: Fri Nov 06, 2020 1:59 pm
parakorn wrote: Thu Nov 05, 2020 4:13 pm ขอตัวอย่างไฟล์ Text ด้วยครับผม
ผมแนบไฟล์ text (txt) ไม่ได้ครับ ระบบแจ้งนามสุกลไม่ถูกต้องครับ
บีบไฟล์ ด้วย win rar ก่อนครับ

ไฟล์ text ตัวอย่างครับ ขอบพระคุณครับ

snasui · #11

การโพสต์ Code ควรจะวางแล้วให้แสดงเป็นตัวอักษรแบบ Code ดูได้ที่กฎการใช้บอร์ดข้อ 5 ด้านบน

วางแล้วจะได้ดังลักษณะด้านล่างนี้ ไม่ใช่แสดงเป็นตัวอักษรธรรมดา จะได้สะดวกในการอ่านทั้งยังสะดวกต่อการคัดลอกไปทดสอบครับ

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
    x = 1
'    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    Workbooks.OpenText Filename:=FilesToOpen(x), Origin:= _
        65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True

'    wkbTemp.Sheets(1).Copy
'    Set wkbAll = ActiveWorkbook
'    wkbTemp.Close (False)
'    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
'      Destination:=Range("A1"), DataType:=xlDelimited, _
'      TextQualifier:=xlDoubleQuote, _
'      ConsecutiveDelimiter:=False, _
'      Tab:=False, Semicolon:=False, _
'      Comma:=False, Space:=False, _
'      Other:=True, OtherChar:="|"
'    x = x + 1
'
'    While x <= UBound(FilesToOpen)
'        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
'        With wkbAll
'            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
'            .Worksheets(x).Columns("A:A").TextToColumns _
'              Destination:=Range("A1"), DataType:=xlDelimited, _
'              TextQualifier:=xlDoubleQuote, _
'              ConsecutiveDelimiter:=False, _
'              Tab:=False, Semicolon:=False, _
'              Comma:=False, Space:=False, _
'              Other:=True, OtherChar:=sDelimiter
'        End With
'        x = x + 1
'    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

9KiTTi · #12

snasui wrote: Sat Nov 07, 2020 12:16 pm

การโพสต์ Code ควรจะวางแล้วให้แสดงเป็นตัวอักษรแบบ Code ดูได้ที่กฎการใช้บอร์ดข้อ 5 ด้านบน

วางแล้วจะได้ดังลักษณะด้านล่างนี้ ไม่ใช่แสดงเป็นตัวอักษรธรรมดา จะได้สะดวกในการอ่านทั้งยังสะดวกต่อการคัดลอกไปทดสอบครับ

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
    x = 1
'    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    Workbooks.OpenText Filename:=FilesToOpen(x), Origin:= _
        65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True

'    wkbTemp.Sheets(1).Copy
'    Set wkbAll = ActiveWorkbook
'    wkbTemp.Close (False)
'    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
'      Destination:=Range("A1"), DataType:=xlDelimited, _
'      TextQualifier:=xlDoubleQuote, _
'      ConsecutiveDelimiter:=False, _
'      Tab:=False, Semicolon:=False, _
'      Comma:=False, Space:=False, _
'      Other:=True, OtherChar:="|"
'    x = x + 1
'
'    While x <= UBound(FilesToOpen)
'        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
'        With wkbAll
'            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
'            .Worksheets(x).Columns("A:A").TextToColumns _
'              Destination:=Range("A1"), DataType:=xlDelimited, _
'              TextQualifier:=xlDoubleQuote, _
'              ConsecutiveDelimiter:=False, _
'              Tab:=False, Semicolon:=False, _
'              Comma:=False, Space:=False, _
'              Other:=True, OtherChar:=sDelimiter
'        End With
'        x = x + 1
'    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

ขออภัยครับ ต่อไปจะระมัดระวังให้มากขึ้นครับ ขอบพระคุณครับ

9KiTTi · #13

snasui wrote: Sat Nov 07, 2020 12:16 pm

การโพสต์ Code ควรจะวางแล้วให้แสดงเป็นตัวอักษรแบบ Code ดูได้ที่กฎการใช้บอร์ดข้อ 5 ด้านบน

วางแล้วจะได้ดังลักษณะด้านล่างนี้ ไม่ใช่แสดงเป็นตัวอักษรธรรมดา จะได้สะดวกในการอ่านทั้งยังสะดวกต่อการคัดลอกไปทดสอบครับ

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
    x = 1
'    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    Workbooks.OpenText Filename:=FilesToOpen(x), Origin:= _
        65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True

'    wkbTemp.Sheets(1).Copy
'    Set wkbAll = ActiveWorkbook
'    wkbTemp.Close (False)
'    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
'      Destination:=Range("A1"), DataType:=xlDelimited, _
'      TextQualifier:=xlDoubleQuote, _
'      ConsecutiveDelimiter:=False, _
'      Tab:=False, Semicolon:=False, _
'      Comma:=False, Space:=False, _
'      Other:=True, OtherChar:="|"
'    x = x + 1
'
'    While x <= UBound(FilesToOpen)
'        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
'        With wkbAll
'            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
'            .Worksheets(x).Columns("A:A").TextToColumns _
'              Destination:=Range("A1"), DataType:=xlDelimited, _
'              TextQualifier:=xlDoubleQuote, _
'              ConsecutiveDelimiter:=False, _
'              Tab:=False, Semicolon:=False, _
'              Comma:=False, Space:=False, _
'              Other:=True, OtherChar:=sDelimiter
'        End With
'        x = x + 1
'    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

ผมนำไปทดสอบใช้งานแล้วครับ สามารถนำเข้าแล้วไม่มีปัญหาภาษาไทย แต่ถ้าหากไม่สามารถนำเข้า text ไฟล์ได้ครั้งละหลายๆไฟล์ครับ และผมก็ยังแก้เรื่องการแสดงผลตัวเลขไม่ได้ครับ รบกวนอาจารย์แนะนำผมด้วยครับ

snasui · #14

การแสดงผลตัวเลขเกิดจาก Format ไม่ใช่ค่าผิดพลาด ค่าจริงเป็นเท่าไรก็เท่านั้น ไม่ใช่เรื่องที่น่ากังวลครับ

หากต้องการจะให้แสดง Format เป็นแบบไหนสามารถเขียน Code เข้าไปจัดการได้ตามสะดวก ตัวอย่างหนึ่งของการจัด Format ดูได้ที่นี่ครับ viewtopic.php?t=11372#p70421

การนำเข้าหลาย ๆ ไฟล์ก็ทำได้ตามปกติ หลักการคือเปิดไฟล์มาแล้วคัดลอกไปวางในตำแหน่งปลายทาง ฯลฯ ครับ

9KiTTi · #15

snasui wrote: Sat Nov 07, 2020 8:14 pm การแสดงผลตัวเลขเกิดจาก Format ไม่ใช่ค่าผิดพลาด ค่าจริงเป็นเท่าไรก็เท่านั้น ไม่ใช่เรื่องที่น่ากังวลครับ

หากต้องการจะให้แสดง Format เป็นแบบไหนสามารถเขียน Code เข้าไปจัดการได้ตามสะดวก ตัวอย่างหนึ่งของการจัด Format ดูได้ที่นี่ครับ viewtopic.php?t=11372#p70421

การนำเข้าหลาย ๆ ไฟล์ก็ทำได้ตามปกติ หลักการคือเปิดไฟล์มาแล้วคัดลอกไปวางในตำแหน่งปลายทาง ฯลฯ ครับ

สุดความสามารถครับอาจารย์ ผมลองมา 2 วันแล้ว ค้นใน google ก็ไม่ได้ครับ code ที่อาจารย์ปรับให้สามารถนำเข้าเป็นภาษาไทยได้ แต่ในช่อง cid กับ d_update ซึ่งเป็นตัวเลขบัตรประจำตัวประชาชนกับวันเดือนปี ยังต้องแก้โดยไม่ให้มีจุดทศนิยมครับ และไม่สามารถนำเข้าคร่าวละๆหลายไฟล์ได้ครับ รบกวนอาจารย์ช่วยแนะนำด้วยครับ ขอบพระคุณครับ

9KiTTi · #16

snasui wrote: Sat Nov 07, 2020 8:14 pm การแสดงผลตัวเลขเกิดจาก Format ไม่ใช่ค่าผิดพลาด ค่าจริงเป็นเท่าไรก็เท่านั้น ไม่ใช่เรื่องที่น่ากังวลครับ

หากต้องการจะให้แสดง Format เป็นแบบไหนสามารถเขียน Code เข้าไปจัดการได้ตามสะดวก ตัวอย่างหนึ่งของการจัด Format ดูได้ที่นี่ครับ viewtopic.php?t=11372#p70421

การนำเข้าหลาย ๆ ไฟล์ก็ทำได้ตามปกติ หลักการคือเปิดไฟล์มาแล้วคัดลอกไปวางในตำแหน่งปลายทาง ฯลฯ ครับ

Code: Select all

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
            .TextFilePlatform = 65001
            .TextFileDecimalSeparator = ","
            .TextFileOtherDelimiter = "|"

            .Refresh BackgroundQuery:=False
        End With

ActiveSheet.Range("A1").AutoFilter Field:=1, Visibledropdown:=True
ActiveSheet.Range("A1").AutoFilter Field:=2, Visibledropdown:=True

        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

ตอนนี้ผมปรับใช้ code นี้ครับ แต่ยังเหลือปัญหาที่ยังแก้ไม่ได้คือเรื่องการจัด format ครับ และถ้าหากไม่ได้เลือกไฟล์นำเข้าจะมี error แจ้งขึ้นมาครับ รบกวนอาจารย์ช่วยผมด้วยครับ

snasui · #17

แนบไฟล์ล่าสุดที่มี Code นี้มาด้วยจะได้ตอบต่อไปจากนั้นครับ

9KiTTi · #18

snasui wrote: Mon Nov 09, 2020 7:58 pm แนบไฟล์ล่าสุดที่มี Code นี้มาด้วยจะได้ตอบต่อไปจากนั้นครับ

ขอบพระคุณครับอาจารย์

9KiTTi · #19

ตอนนี้ปรับแก้สามารถให้แสดงข้อความตามรูปแบบที่ต้องการได้แล้วครับ เหลือเพียง error ที่แสดงตามภาพหากไม่ได้เลือกข้อมูออะไรเลยครับ

Code: Select all

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:="เลือกข้อมูลที่ต้องการนำเข้า By KiTTi")

    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
            .TextFilePlatform = 65001
            .TextFileOtherDelimiter = "|"

            .Refresh BackgroundQuery:=False
        End With

    ActiveSheet.Range("A1").AutoFilter Field:=1, Visibledropdown:=True
    ActiveSheet.Range("A1").AutoFilter Field:=2, Visibledropdown:=True

       Cells.Select
        Selection.NumberFormat = "0"
    
        For Each qt In ActiveSheet.QueryTables
            qt.Delete
        Next qt
    Next txtfile

    Application.ScreenUpdating = True
    MsgBox "นำข้อมูลเข้าสำเร็จแล้ว!", vbInformation, "สำเร็จแล้ว"

    Set fso = Nothing
End Sub

error.jpg

puriwutpokin · #20

ดัก Error ไว้ใต้ ประกาศตัวแปรครับ

Code: Select all

On Error Resume Next

Snasui Excel Forum

File Anatomy Add-in: ตรวจสอบโครงสร้างไฟล์ Excel อย่างมืออาชีพ

ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย

Re: ขอสอบถามวิธีการแก้ไขนำไฟล์เข้าแล้วไม่เป็นภาษาไทย