vba รันไม่ได้ เนื่องจาก ชื่อไฟล์มีคำว่า [ซ่อมแซมแล้ว]

[sutham]

เมื่อเปิดไฟล์ pp5-v.4.65II แล้วกดปุ่ม "นำเข้ารายชื่อนักเรียน" และเลือกไฟล์ที่ต้องการนำเข้า ชื่อ "View_ClassStudents12566"
โปรแกรมขึ้น Run-time error 1004 เมื่อกดปุ่ม Debug ขึ้น error ดังรูป error2.jpg


เมื่อกดเข้าไปที่ไฟล์โดยตรง ชื่อไฟล์ "DataBasePP5" ในโฟอล์เดอร์ DataPP5 จะมีกล่องข้อความเตือน ดังรูป error1.jpg


รบกวนขอคำแนะนำในการปรับแก้ไขในกรณีดังกล่าว ครับ
ขอบคุณครับ

[snasui]

เมื่ออ้างถึงชื่อไฟล์ให้เขียนนามสกุลไฟล์เข้าไปด้วยเช่นด้านล่างครับ

Code: Select all

Set rn = Workbooks("PP5-v.4.65II.xlsb").Worksheets("Start").Range("aa9")
Set CrntWorkBook = Workbooks("DataBasePP5.xlsm")

สังเกตว่ามี .xlsb, .xlsm อยู่ด้วยเสมอ เข้าไปเปลี่ยนยังตำแหน่งอื่น ๆ ใน Code เสียด้วยครับ

ไฟล์ที่แนบมาผมทดสอบแล้วไม่ติดปัญหาใด

ส่วนไฟล์ที่มีคำว่า [ซ่อมแซมแล้ว] ปกติเราจะไม่ใช้กันเพราะมีบางส่วนที่โปรแกรมลบทิ้งไปจากการที่เกิด Error แล้วเรายอมรับให้โปรแกรมซ่อมแซมอัตโนมัติ การนำไฟล์นี้มาใช้ย่อมมีความเสี่ยงเพราะโครงสร้างบางส่วนถูกลบทิ่งไปแล้ว

[sutham]

ขอสอบถามเพิ่มเติมเกี่ยวนามสกุลไฟล์ เมื่อมีการบันทึกแมโคร ระหว่าง .xlsb กับ .xlsm ควรบันทึกไฟล์นามสกุลไหน จึงจะเหมาะสมกับการใช้งานมากว่ากันครับ
ขอบคุณครับ

[snasui]

ศึกษาได้จากที่ผมเคยโพสต์ไว้ที่นี่ครับ เรื่องน่ารู้เกี่ยวกับนามสกุลไฟล์และอื่น ๆ

[sutham]

ผมลองปรับ code โดยเพิ่มนามสกุลไฟล์ เมื่อรัน code ครั้งแรกจะไม่ติดปัญหา
แต่พอกดปุ่มนำ "นำเข้ารายชื่อนักเรียน" ซ้ำก็จะติดตรง code นี้อีก

Code: Select all

	Workbooks.Open Filename:=Range("AA9").Value & "\ExcelToSGS\DataPP5\DataBasePP5.xlsm" 

เป็นเพราะ code ที่ผมเขียนให้บันทึกไฟล์ ก่อนปิด workbook หรือไม่ครับ
ที่ทำให้ไฟล์โปรแกรมซ่อมแซมอัตโนมัติ
code ที่เขียนให้บันทึกไฟล์ก่อนปิด workbook

Code: Select all

                    Application.DisplayAlerts = False
                    CrntWorkBook.Activate
                    CrntWorkBook.Save
                    CrntWorkBook.Close
                    Application.DisplayAlerts = True
        
                    MsgBox ("การนำเข้าข้อมูล...สำเร็จ"), vbInformation, "Information..."
                    Application.ScreenUpdating = True
                    Exit Sub

code ที่ปรับแก้แล้วครับ

Code: Select all

Sub ImportDataName()
    Dim CrntWorkBook As Workbook 'ไฟล์ของเรา
    Dim SourceBook As Workbook 'ไฟล์ที่จะ Copy
    Dim SourceRange As Range 'range ของไฟล์ที่จะ  Copy
    Dim Destination As Range 'range ของไฟล์ที่จะวาง
    Dim rn As Range
    Dim i As Integer, ii As Integer, iii As Integer, aa As Integer
    MsgBox ("โปรดรอสักครู่...จนกว่าระบบจะนำเข้าข้อมูลสำเร็จ !!!"), vbInformation, "Information..."
    Workbooks.Open Filename:=Range("AA9").Value & "\ExcelToSGS\DataPP5\DataBasePP5.xlsm"  'เปิดไฟล์  Database
    Set rn = Workbooks("PP5-v.4.65II.xlsb").Worksheets("Start").Range("aa9")
    Set CrntWorkBook = Workbooks("DataBasePP5.xlsm")
    
        Application.ScreenUpdating = False
        Worksheets("DBStudent").Select
        CrntWorkBook.Worksheets("DBStudent").Unprotect Password:="123456789"
        CrntWorkBook.Worksheets("DBStudent").Range("G5", "X10000").ClearContents

     With Application.FileDialog(msoFileDialogOpen)
        .Title = "เลือก File รายชื่อที่ต้องการนำเข้า !!!!  "
        .InitialFileName = ThisWorkbook.Path & "\"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*;*.xlsx*;*.xlsm*;*.xlsb*"
        .AllowMultiSelect = False
        .Show
         
        If .SelectedItems.Count > 0 Then
                Workbooks.Open .SelectedItems(1)
                Set SourceBook = ActiveWorkbook
                
                SourceBook.Activate
                i = Application.WorksheetFunction.CountA(SourceBook.Worksheets("sheet1").Range("A:A"))
                Set SourceRange = SourceBook.Worksheets("sheet1").Range("A2", "N" & i)   'range ของไฟล์ที่จะ  Copy
                
                CrntWorkBook.Activate
                'Call UnprotectSh
                CrntWorkBook.Save
                Set Destination = CrntWorkBook.Worksheets("DBStudent").Range("G5")  'range ของไฟล์ที่จะวาง
                SourceRange.Copy   'Destination
                Destination.PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                SourceBook.Close SaveChanges:=False
           
        'ใส่สูตรในเซลล์
         ii = Application.WorksheetFunction.CountA(Workbooks("DatabasePP5").Worksheets("DBStudent").Range("G5:G10000")) + 4 'นับเซลล์ทีมีข้อมูลจริง
        CrntWorkBook.Worksheets("DBStudent").Range("U5", "U" & ii).Formula = "=IF(OR(Q5=""เด็กชาย"",Q5=""นาย""),1,2)"  'เพศ
        CrntWorkBook.Worksheets("DBStudent").Range("V5", "V" & ii).Formula = "=RIGHT(H5)&I5"  'ชั้น/ห้อง
        CrntWorkBook.Worksheets("DBStudent").Range("W5", "W" & ii).Formula = "=V5&U5&P5"  'code เรียงลำดับ
        CrntWorkBook.Worksheets("DBStudent").Range("X5", "X" & ii).Formula = "=IF(V5=nameST!$B$1,MAX($X$4:X4)+1,"""")"  'No.new
        
    'เรียงลำดับ
        Workbooks("DataBasePP5").Worksheets("DBStudent").Sort.SortFields.Add Key:=Range( _
        "W4", "W" & ii), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal   'เงื่อนไขที่ 1
            With CrntWorkBook.Worksheets("DBStudent").Sort
                .SetRange Range("G4", "X" & ii)
                .Header = xlYes
               .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
                    Application.DisplayAlerts = False
                    CrntWorkBook.Activate
                    CrntWorkBook.Save
                    CrntWorkBook.Close
                    Application.DisplayAlerts = True
        
                    MsgBox ("การนำเข้าข้อมูล....สำเร็จ"), vbInformation, "Information..."
                    Application.ScreenUpdating = True
                    Exit Sub

            Else
                MsgBox ("คุณครูยังไม่ได้เลือกไฟล์รายชื่อที่ต้องการนำเข้า !!!! "), vbCritical 'ถ้าไม่ได้เลือกไฟล์
            End If
        End With

End Sub

[snasui]

ถ้าติดปัญหาบรรทัดนี้ Workbooks.Open Filename:=Range("AA9").Value & "\ExcelToSGS\DataPP5\DataBasePP5.xlsm" ก็แสดงว่าไฟล์นี้ไม่มีอยู่จริง จำเป็นต้องตรวจสอบทุกอักขระว่าตรงกับตำแหน่งและชื่อไฟล์ที่ต้องการนำมาใช้งานหรือไม่ครับ

ถ้าตรงกันทุกประการย่อมต้องเปิดไฟล์ได้ครับ

[sutham]

ผมลองตรวจสอบแล้ว และลองเปลี่ยน code โดยไม่ใช้การอ้างอิงจากเซลล์

Code: Select all

Workbooks.Open Filename:="E:\ExcelToSGS\DataPP5\DataBasePP5.xlsm"

ก็ยังติด error

พอลองกดเปิดไฟล์ DataBasePP5.xlsm ที่อยู่ใน E:\ExcelToSGS\DataPP5 โดยตรง ปรากฎว่าไฟล์โปรแกรมนั้นเป็นไฟล์ซ่อมแซมอัตโนมัติ
ไม่ทราบว่าสาเหตุเกิดจากส่วนไหน และจะแก้ไขเหตุการณ์นี้ได้หรือไม่ครับ

[snasui]

เปิดด้วยมือแล้วกลายเป็นไฟล์ซ่อมแซมอัตโนมัติก็เป็นไปได้ว่าไฟล์นั้นเสียหาย ไม่ทราบว่าก่อนหน้านั้นมันทำงานได้ปกติหรือไม่ การ Save ธรรมดาย่อมไม่ทำให้ไฟล์เสียหายได้ ลองเปลี่ยนตำแหน่งการเก็บไฟล์ดูครับ