Code VB ตรวจสอบชื่อไฟล์ก่อนนำเข้าข้อมูล

[tigerwit]

จากไฟล์ที่แนบมา

Code: Select all

Sub ImportScoreFormCSV()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  '
    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, "ยกเลิกการนำเข้าข้อมูล"
        Else
            Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
                Set wbTextImport = ActiveWorkbook
                Set wsMaster = ThisWorkbook.ActiveSheet
'                wsMaster.Unprotect Password:="ultraman711"
                wsMaster.Range("F6:S50,U6:V50,Z6:AM50,AO6:AP50").ClearContents
                       wbTextImport.Worksheets(1).Range("A1:N50").Copy
                        wsMaster.Range("F6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("O1:P50").Copy
                        wsMaster.Range("U6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("Q1:AD50").Copy
                        wsMaster.Range("Z6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("AE1:AF50").Copy
                        wsMaster.Range("AO6").PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                    wbTextImport.Close False
        Range("F6").Select
'                wsMaster.Protect Password:="ultraman711"
    End If
        End If
Exit Sub
        Application.ScreenUpdating = True
                wsMaster.Protect Password:="11651165"
End Sub

ต้องการตรวจสอบว่าไฟล์ที่นำเข้านั้น มีชื่อไฟล์ตรงกับวิชาที่แสดงใน เซลล์ A18 หรือ ถ้าตรงให้นำเข้า ถ้าไม่ตรงให้แสดงการแจ้งเตือนว่าไม่ใช่ไฟล์ที่จะนำเข้า แล้ว ยกเลิกการนำเข้า
จะต้องปรับ Code อย่างไรครับ

(ชื่อไฟล์จะมีคำว่าคะแนนนำหน้า และจะเว้นวรรคแล้วต่อด้วยห้อง ทุกไฟล์ เช่น คะแนนสังคมศึกษา ห้อง1 คะแนนพละ ห้อง1 คะแนนภาษาไทย ห้อง1)

[snasui]

ตัวอย่างการตรวจสอบชื่อไฟล์กับเซลล์ A18 หากไม่ตรงให้ยกเลิกการทำงานครับ

Code: Select all

'Other code
If fileToOpen = False Then
        MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
Else
    If Not VBA.InStr(fileToOpen, Range("a18").Value) Then
        'Your message
        Exit Sub
    End If
    Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
        Set wbTextImport = ActiveWorkbook
        Set wsMaster = ThisWorkbook.ActiveSheet
'Other code

[tigerwit]

ขอบคุณครับ
ทดสอบแล้วยังมีปัญหา ไม่สามารถนำเข้าได้ทั้งที่ชื่อไฟล์ กับ ชื่อใน A18 ตรงกัน
ไม่ทราบว่าเกิดจากสาเหตุใดครับ

Code: Select all

Sub ImportScoreFormCSV()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
    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, "ยกเลิกการนำเข้าข้อมูล"
        Else
        If Not VBA.InStr(fileToOpen, Range("a18").Value) Then
            MsgBox "ชื่อไฟล์นำเข้าไม่ถูกต้อง", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
        Exit Sub
        End If
   
    Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
        Set wbTextImport = ActiveWorkbook
        Set wsMaster = ThisWorkbook.ActiveSheet
    Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
        Set wbTextImport = ActiveWorkbook
        Set wsMaster = ThisWorkbook.ActiveSheet
        
            Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
                Set wbTextImport = ActiveWorkbook
                Set wsMaster = ThisWorkbook.ActiveSheet
'                wsMaster.Unprotect Password:="ultraman711"
                wsMaster.Range("F6:S50,U6:V50,Z6:AM50,AO6:AP50").ClearContents
                       wbTextImport.Worksheets(1).Range("A1:N50").Copy
                        wsMaster.Range("F6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("O1:P50").Copy
                        wsMaster.Range("U6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("Q1:AD50").Copy
                        wsMaster.Range("Z6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("AE1:AF50").Copy
                        wsMaster.Range("AO6").PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                    wbTextImport.Close False
        Range("F6").Select
'                wsMaster.Protect Password:="ultraman711"
    End If
        End If
Exit Sub
        Application.ScreenUpdating = True
                wsMaster.Protect Password:="11651165"
End Sub

[snasui]

ปรับ Statement ในการตรวจสอบเป็นด้านล่างครับ

If VBA.InStr(fileToOpen, Range("a18").Value) = 0 Then

[tigerwit]

ได้แล้วครับ
ขอบคุณครับ

[tigerwit]

อาจารย์ครับ
อยากทราบความหมายของบรรทัดนี้

Code: Select all

If VBA.InStr(fileToOpen, Range("a18").Value) = 0 Then

[snasui]

แปลว่าให้หาว่า Range("a18").Value มีอยู่ใน fileToOpen หรือไม่

หากมีจะแสดงค่าตำแหน่งที่พบ หากไม่มีจะแสดงค่าเป็น 0 ครับ