Code VB ป้องกันไม่ให้นำเข้าไฟล์ .CSV ผิดไฟล์

[tigerwit]

จากไฟล์ที่แนบมา
หากต้องการป้องกันไม่ให้นำเข้าไป .CSV ซึ่งมีโครงสร้างไฟล์ต่างกันจะต้องปรับโค๊ดอย่างไรครับ
(คิดไว้ว่าจะให้ตรวจสอบชื่อไฟล์ว่าตรงกับ เซลล์ A19 หรือไม่ ถ้าตรงก็ให้นำเข้า ถ้าไม่ตรงก็ให้แจ้งเตือน)

Code: Select all

Sub Imp_Score()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  Application.ScreenUpdating = False
        If MsgBox("คุณต้องการนำเข้าผลการเรียน ใช่หรือไม่?", 36, "ยืนยันการนำเข้าผลการเรียน") = 6 Then
                fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้าข้อมูล", FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
                    If fileToOpen = False Then
                        MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
                    Else
                        Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
                                Set wbTextImport = ActiveWorkbook
                                Set wsMaster = ThisWorkbook.ActiveSheet
                                'wsMaster.Unprotect Password:="11651165"
                                wsMaster.Range("F6:J50,L6:P50,R6:V50,X6:AB50").ClearContents
                                wbTextImport.Worksheets(1).Range("A1:E50").Copy
                                wsMaster.Range("F6").PasteSpecial xlPasteValues
                                wbTextImport.Worksheets(1).Range("F1:J50").Copy
                                wsMaster.Range("L6").PasteSpecial xlPasteValues
                                wbTextImport.Worksheets(1).Range("K1:O50").Copy
                                wsMaster.Range("R6").PasteSpecial xlPasteValues
                                wbTextImport.Worksheets(1).Range("P1:T50").Copy
                                wsMaster.Range("X6").PasteSpecial xlPasteValues
                                Application.CutCopyMode = False
                                wbTextImport.Close False
                        Range("F6").Select
'                       wsMaster.Protect Password:="11651165"
    		End If
                End If
		Exit Sub
'        wsMaster.Protect Password:="11651165"
        Application.ScreenUpdating = True
End Sub

[tigerwit]

ไฟล์สำหรับนำเข้า

[tigerwit]

ลองปรับโค๊ดไปเรื่อย ๆ ก็ยังติดขัดอยู่

Code: Select all

Sub Imp_Score()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  Application.ScreenUpdating = False
  
If MsgBox("คุณต้องการนำเข้าผลการเรียน ใช่หรือไม่?", 36, "ยืนยันการนำเข้าผลการเรียน") = 6 Then
    Application.ScreenUpdating = False
    fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้าข้อมูล", FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
    If fileToOpen = False Then
            MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
    ElseIf VBA.Right(fileToOpen, InStrRev(fileToOpen, "\")) <> Sheet1.Range("A19").Value & ".csv" Then
            MsgBox "ไฟล์นำเข้าไม่ถูกต้อง กรุณาตรวจสอบ", vbInformation
    Exit Sub
    Else
                        Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
                                Set wbTextImport = ActiveWorkbook
                                Set wsMaster = ThisWorkbook.ActiveSheet
                                'wsMaster.Unprotect Password:="11651165"
                                wsMaster.Range("F6:J50,L6:P50,R6:V50,X6:AB50").ClearContents
                                wbTextImport.Worksheets(1).Range("A1:E50").Copy
                                wsMaster.Range("F6").PasteSpecial xlPasteValues
                                wbTextImport.Worksheets(1).Range("F1:J50").Copy
                                wsMaster.Range("L6").PasteSpecial xlPasteValues
                                wbTextImport.Worksheets(1).Range("K1:O50").Copy
                                wsMaster.Range("R6").PasteSpecial xlPasteValues
                                wbTextImport.Worksheets(1).Range("P1:T50").Copy
                                wsMaster.Range("X6").PasteSpecial xlPasteValues
                                Application.CutCopyMode = False
                                wbTextImport.Close False
                        Range("F6").Select
'                       wsMaster.Protect Password:="11651165"
    End If
                End If
'Exit Sub
'        wsMaster.Protect Password:="11651165"
        Application.ScreenUpdating = True
End Sub

[snasui]

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

Code: Select all

'Other code
    If fileToOpen = False Then
        MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
'    ElseIf VBA.Right(fileToOpen, InStrRev(fileToOpen, "\")) <> Sheet1.Range("A19").Value & ".csv" Then
'        MsgBox "ไฟล์นำเข้าไม่ถูกต้อง กรุณาตรวจสอบ", vbInformation
'        Exit Sub
    ElseIf Dir(fileToOpen) <> Sheet1.Range("a19").Value & ".csv" Then
        MsgBox "Error. Please check file name again.", vbExclamation
        Exit Sub
    Else
'Other code

[tigerwit]

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

Code: Select all

Sub LockArea()
    Sheets("Score").ScrollArea = "A1:AE56"
    Sheets("Name").ScrollArea = "A1:K1000"
    Sheets("Index").ScrollArea = "A1:K50"
End Sub

แล้วไปเรียกใช้งานเมื่อ Workbook Activate ปรากฎว่า จะมีปัญหา

Code: Select all

Private Sub Workbook_Activate()
LockArea
End Sub

แต่ถ้าหากเขียนตรง ๆ ลงใน Workbook Activate จะไม่มีปัญหา

Code: Select all

Private Sub Workbook_Activate()
    Sheets("Score").ScrollArea = "A1:AE56"
    Sheets("Name").ScrollArea = "A1:K1000"
    Sheets("Index").ScrollArea = "A1:K50"
End Sub

ไม่ทราบว่ากรณีนี้เกิดจากสาเหตุใดครับ

[snasui]

ผมทดสอบด้วย O365 ไม่พบว่าเกิดปัญหาใดครับ

[tigerwit]

ขอบคุณครับ