ขออนุญาตสอบถามการนำไฟล์อื่นเข้า workbook ใหม่ ติดปัญหานำเข้าไม่ได้

[9KiTTi]

ขออนุญาตสอบถามการนำไฟล์อื่นเข้า workbook ใหม่ ติดปัญหานำเข้าไม่ได้ เนื่องจากไฟล์มีรูปแบบที่เยอะมาเกินไป ไม่ทราบว่ามีวิธีเคลียร์รูปแบบไฟล์ เช่น Hyperlinks หรือ สี หรือรูปแบบอื่นๆ ก่อนนำเข้าไหมครับ โดยที่หลังจากเลือกจำนวนไฟล์ที่ต้องการ แล้วให้ทำการเคลียร์รูปแบบใน worksheets ก่อนแล้วค่อยนำเข้า ผมมี VBA ได้ถึงแค่ขั้นตอการเลือกไฟล์นำเข้า แต่หลังจากนั้น vba ไม่ทำงาน จะติด error ตามภาพครับ แต่ถ้า worksheet ที่นำเข้ามีรูปแบบไม่เยอะจำนำเข้าได้ปกติ และผมไม่สามารถกำหนดรูปแบบฟล์ที่ได้รับมาเพื่อทำงานครับ

ขออนุญาตไม่มีไฟล์ตัวอย่างที่จะนำเข้านะครับ เพราะไฟล์มีขนาดใหญ่ประมาณ 4 mb. และมีข้อมูลส่วนบุคคล และอีกประการเพราะถ้าหากเปิดไฟล์แล้วก็จะบันทึกใหม่ ทำให้นำเข้าได้ปกติ แต่จะไม่สะดวกกับผู้ใช้งาน เพราะบางคนไม่ถนัดใช้ excel หรือบางครั้งมีจำนวนไฟล์เป็นจำนวนมาก ต้องขออภัยด้วยครับ

ขอบพระคุณครับ

[9KiTTi]

ผมพยายามแก้ code มาให้แบบนี้แต่ก็ไม่สำเร็จ รบกวนแนะนำด้วยครับ

Code: Select all

Sub add()
    
    'On Error Resume Next

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    Dim FNames As Variant
    Dim Cnt As Long
    Dim MstWbk As Workbook
    Dim ws As Worksheet

    Set MstWbk = ThisWorkbook

    FNames = Application.GetOpenFilename(fileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True, Title:="àÅ×Í¡ä¿Åì·Õè¨Ð¹Óà¢éÒµÃǨÊͺ")
    If Not IsArray(FNames) Then Exit Sub
    
    ' ** clear all formats on master workbook
    ThisWorkbook.ActiveSheet.Cells.ClearFormats
    For Cnt = 1 To UBound(FNames)
        Set ws = Workbooks.Open(FNames(Cnt)).Sheets(1)
        ' ** clear all formats on the imported workbook
        ' ws.Cells.ClearFormats
        ws.Copy After:=MstWbk.Sheets(MstWbk.Sheets.Count)
        MstWbk.Sheets(MstWbk.Sheets.Count).Name = Left(ws.Parent.Name, InStr(2, ws.Parent.Name, ".") - 1)
        ws.Parent.Close False
    Next Cnt

    MsgBox "¹Óà¢éÒä¿ÅìÊÓàÃç¨!", vbInformation
    
    Application.ScreenUpdating = True
    
    Application.DisplayAlerts = True

End Sub

[snasui]

จากภาพ Error นั้น Code ไปหยุดอยู่ที่บรรทัดไหนช่วยแจ้งหรือจับภาพประกอบมาด้วยครับ

[9KiTTi]

ตามภาพครับอาจารย์

[snasui]

ลองเพิ่ม Code ตามภาพ หากรันแล้วติดบรรทัดที่ 2 แสดงว่าเปิดไฟล์ไม่ได้ เมื่อเปิดไฟล์ไม่ได้ก็ย่อมจะทำงานต่อไม่ได้ครับ

[9KiTTi]

run time error 9 ครับอาจารย์

Code: Select all

Sub add2()
    
    'On Error Resume Next

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    Dim FNames As Variant
    Dim Cnt As Long
    Dim MstWbk As Workbook
    Dim ws As Worksheet
    Dim wb As Workbook
    Set MstWbk = ThisWorkbook

    FNames = Application.GetOpenFilename(fileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True, Title:="choose Files")
    If Not IsArray(FNames) Then Exit Sub
    
    ThisWorkbook.ActiveSheet.Cells.ClearHyperlinks
    Set wb = Workbooks.Open(FNames(Cnt))
    For Cnt = 1 To UBound(FNames)
        Set ws = Workbooks.Open(FNames(Cnt)).Sheets(1)
        ws.Copy After:=MstWbk.Sheets(MstWbk.Sheets.Count)
        MstWbk.Sheets(MstWbk.Sheets.Count).Name = Left(ws.Parent.Name, InStr(2, ws.Parent.Name, ".") - 1)
        ws.Parent.Close False
    Next Cnt

    MsgBox "Import complete!", vbInformation
    
    Application.ScreenUpdating = True
    
    Application.DisplayAlerts = True

End Sub

[snasui]

ก็เป็นไปตามที่ผมแจ้งไปแล้วในโพสต์ก่อน คือเปิดไม่ได้ และทำงานต่อไม่ได้

การที่จะ Clear รูปแบบหรือสิ่งใด ๆ ก็ตามต้องเปิดไฟล์ขึ้นมาให้ได้ก่อน ซึ่ง Code ที่เขียนให้นั้นคือสั่งให้เปิดไฟล์ครับ

[9KiTTi]

ก็เป็นไปตามที่ผมแจ้งไปแล้วในโพสต์ก่อน คือเปิดไม่ได้ และทำงานต่อไม่ได้

การที่จะ Clear รูปแบบหรือสิ่งใด ๆ ก็ตามต้องเปิดไฟล์ขึ้นมาให้ได้ก่อน ซึ่ง Code ที่เขียนให้นั้นคือสั่งให้เปิดไฟล์ครับ

แก้ไขได้แล้วครับอาจารย์ ปรับแก้ที่เว็บที่ส่งออกข้อมูลเลยครับ