จะกำหนดให้นำเข้า text ไฟล์ ใน field ที่ต้องการอย่างไรครับ

[9KiTTi]

จะเขียน VBAS เพื่อกำหนดให้นำเข้า text file เข้าใน sheet ใน filed ที่ต้องการอย่างไรครับ เช่นจะให้นำเข้าที่ A5 ครับ ขอบพระคุณครับ

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:="เลือกไฟล์ที่ต้องการนำเข้า by xxxx")
    If VarType(txtfilesToOpen) = vbBoolean Then
        MsgBox "กรุณาเลือกไฟล์ที่จะนำเข้า", , "by xxxx"
        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(1, 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("A1").AutoFilter Field:=1, Visibledropdown:=True
    ActiveSheet.Range("A1").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 ที่ 2 อัตโนมัติ

    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

[logic]

ขอไฟล์เอ็กเซลล์ + วางโค้ดนี้ใน vbe แล้ว + ไฟล์ text ให้เพื่อน ๆ ช่วยดูด้วยครับ

[9KiTTi]

ไฟล์ excel พร้อมตัวอย่างไฟล์ที่ต้องการนำเข้าครับ

[9KiTTi]

แก้ไขได้แล้วครับ เปลี่ยนค่าที่ Destination:=ActiveSheet.Cells(1, 1)) ครับ