ต้องการเปลี่ยนนามสกุลไฟล์หลังจากimport

[aek]

จากกระทู้นี้ https://www.thai-access.com/index.php?topic=540.0 ครับ

Private Sub Command1_Click()
    Dim strPath As String
    Dim strFile As String
    Dim strTable As String
    Dim StrFileName As string

    strTable = "ชื่อตารางเป้าหมาย"     
    strPath = "d:\โฟลเดอร์ที่เก็บไฟล์ .txt"
    strFile = Dir(strPath & "*.txt")

    Do While strFile <> ""
    StrFileName = strPath & strFile       
    DoCmd.TransferText acImportDelim, "importdata", strTable, StrFileName ,False
           
    strFile = Dir
    Loop
End Sub

คือ strPath จะมีไฟล์ใหม่มาเพิ่มตลอด ต้องการไม่ให้ import ไฟล์เดิมซ้ำ(เพราะทำให้โปรแกรม importนานเกินจำเป็น) และไม่อยากลบไฟล์ต้นฉบับ(ต้องการเปลี่ยนจาก *.txt เป็น *.xxx หลักจาก import แล้ว) ต้องเขียนโค้ดเพิ่มอย่างไรครับ ขอบคุณครับ

[ปิ่นณรงค์]

เพิ่มนิดนึงประมาณนี้ครับ เพิ่ม CODE ให้เมื่อ Dir มาแล้ว Import เข้าไปในตารางแล้วก็ให้แก้นามสกุลไฟล์นั้นเป็น .XXX ก่อนจึงจะไป Dir อันใหม่มา Import ต่อ

Private Sub import_Click()
    Dim strPath As String
    Dim strFile As String
    Dim strTable As String
    Dim StrFileName As String
    Dim strextensionNew As String

    strTable = "Table1"
    strPath = "D:\textfile\"
    strFile = Dir(strPath & "*.txt")
    If strFile = "" Then
    MsgBox "ไม่พบไฟล์ที่จะ Import !!", vbCritical, "แจ้งเตือน"
    Exit Sub
    End If
    Do While strFile <> ""
    StrFileName = strPath & strFile
    DoCmd.TransferText acImportDelim, "", strTable, StrFileName, False
   
    strextensionNew = Left(StrFileName, InStrRev(StrFileName, ".") - 1) & ".xxx"
   
   
   
    Name StrFileName As strextensionNew
    strFile = Dir
    Loop
End Sub

[aek]

สุดยอดไปเลย ขอบคุณมากๆครับ ได้ตามที่ต้องการเลยครับ

[aek]

อ.ปิ่นณรงค์ ครับขออนุญาติสอบถามเพิ่ม ถ้าต้องการทราบจำนวนไฟล์ที่ *.txt ในโฟล์เดอ strPath ก่อนที่จำทำการ import ว่ามีกีไฟล์ ไม่ทราบว่าจะต้องเขียน code เพิ่มอย่างไรครับ ขอบคุณครับ

[aek]

ทำได้แล้วครับ แต่ทำให้โปรแกรม import ช้าลงอีก ผู้ใช้งานคงไม่ Happy ขอบคุณครับ

[ปิ่นณรงค์]

โทษทีที่ตอบช้านะครับ
ลองดูตัวอย่างนี้ ใช้การแสดงจำนวนแล้ว สอบถามผู้ใช้เลยว่า ต้องการนำเข้าข้อมูลเลยหรือไม่ครับ ถ้าตอบใช่ก็จะทำการนำเข้าให้ทันที พร้อมเปลี่ยนนามสกุล เป็น .xxx เมื่อนำเข้าแล้วครับ  ส่วนที่ผมใส่สีแดงไว้คือส่วนที่ต้องแก้ให้ตรงกับ Floder และ ตาราง ที่มีอยู่นะครับ


Private Sub Command0_Click()
    Dim Msg As Integer
    Dim count As Integer
    Dim strPath As String
    Dim strFile As String
         
        strPath = "D:\textfile\"
        strFile = Dir(strPath & "*.txt")
    If strFile = "" Then
    MsgBox "ไม่เจอไฟล์ที่จะ import !!", vbCritical, "แจ้งเตือน"
    Exit Sub
    Else
    Do While strFile <> ""
       count = count + 1
        strFile = Dir()
    Loop

     Msg = MsgBox("พบ File =  " & count & " อัน" & vbCrLf & " ต้องการนำเข้าไฟล์เลยหรือไม่?", vbYesNo+vbQuestion, "จำนวนไฟล์ทั้งหมด")

    If Msg = vbYes Then
    Call Import
    End If
           End If     
End Sub


Sub Import()
    Dim strPath As String
    Dim strFile As String
    Dim strTable As String
    Dim StrFileName As String
    Dim strextensionNew As String
   
    strTable = "Table1"
    strPath = "D:\textfile\"
   
    strFile = Dir(strPath & "*.txt")
   
    Do While strFile <> ""
    StrFileName = strPath & strFile
    DoCmd.TransferText acImportDelim, "", strTable, StrFileName, False
    strextensionNew = Left(StrFileName, InStrRev(StrFileName, ".") - 1) & ".xxx"
    Name StrFileName As strextensionNew
    strFile = Dir
    Loop
End Sub

[aek]

ได้แล้วครับ ขอบคุณมากๆ ตอบไม่ช้าหรอกครับ ผมรอได้ครับ

[aung]

รบกวน อาจารย์อีกนิดนึงครับพอดีเจอ BUG ในกรณีที่กำลังจะเปลี่ยนนามสกุลจาก *.txt ไปเป็น *.xxx ถ้ามีไฟล์ *.xxx อยู่แล้วก็จะเกิด error ขึ้น ถ้าผมต้องการให้ลบไฟล์*.xxx(ชื่อเดียวกับ*.txt) นั้นออกเพื่อไม่ให้เกิด error ดังกล่าวผมต้องเพิ่ม code อย่างไรครับ ขอบคุณครับ

[PNR]

แก้เป็นแบบนี้ครับ ในส่วนของ Import()

โค๊ด: [Select]

Sub Import()
    Dim strPath As String
    Dim strFile As String
    Dim strTable As String
    Dim StrFileName As String
    Dim strextensionNew As String
   
    strTable = "Table1"
    strPath = "D:\textfile\"
    strFile = Dir(strPath & "*.txt")
   
    Do While strFile <> ""
    StrFileName = strPath & strFile
    DoCmd.TransferText acImportDelim, "", strTable, StrFileName, False
    strextensionNew = Left(StrFileName, InStrRev(StrFileName, ".") - 1) & ".xxx"
   
    If Len(Dir$(strextensionNew)) > 0 Then
                Kill strextensionNew
    End If
    Name StrFileName As strextensionNew

    strFile = Dir(strPath & "*.txt")
    Loop
End Sub


[kapiak]

ขอบคุณครับผม