:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser
🪷 คำแสดงเจตนา
ขอผลแห่งการให้ความรู้นี้ จงกลับไปยังผู้ที่เป็นเจ้าของเดิม แม้ข้าพเจ้าจะไม่รู้จักท่านก็ตาม ขอให้แสงแห่งปัญญาที่ท่านเคยจุดไว้ ได้กลับไปเติมเต็มชีวิตของท่านอีกครั้ง และขอให้เจตนาของข้าพเจ้าเป็นการคืนความดีอย่างสงบ

codeVB ป้องกันการนำเข้าข้อมูลผิดไฟล์

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Post Reply
User avatar
tigerwit
Silver
Silver
Posts: 553
Joined: Wed Mar 31, 2010 10:51 pm
Location: สกลนคร
Excel Ver: 2019
Contact:
Contact tigerwit

codeVB ป้องกันการนำเข้าข้อมูลผิดไฟล์

#1

Post by tigerwit »

จากไฟล์ที่แนบ
ใช้ codeVB นำเข้าข้อมูลจาก ไฟล์ .csv ได้
แต่อยากป้องกันไม่ให้นำเข้าไฟล์ .csv อื่น ๆ ที่ไม่ใช่ไฟล์ที่เราต้องการ
ต้องเพิ่ม Code อย่างไรครับ

Code: Select all

Sub ImportScore()
  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:="1"
                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:="1"
    End If
        End If
Exit Sub
        Application.ScreenUpdating = True
                wsMaster.Protect Password:="1"
End Sub
หมายเหตุไฟล์ .csv ที่แนบมา ชื่อ "คะแนนคณิตศาสตร์ ห้อง1" คือตัวที่ต้องการนำเข้า
ส่วนไฟล์ชื่อ "GPAคณิตศาสตร์ ป.1" คือตัวที่ผู้ใช้งานอาจหลงนำเข้า
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: codeVB ป้องกันการนำเข้าข้อมูลผิดไฟล์

#2

Post by snasui »

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

Code: Select all

'Other code
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, "\")) <> "คะแนนคณิตศาสตร์ ห้อง1.csv" Then
        MsgBox "Incorrect file name.", vbInformation
        Exit Sub
    Else
        Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
'Other code
Top
User avatar
tigerwit
Silver
Silver
Posts: 553
Joined: Wed Mar 31, 2010 10:51 pm
Location: สกลนคร
Excel Ver: 2019
Contact:
Contact tigerwit

Re: codeVB ป้องกันการนำเข้าข้อมูลผิดไฟล์

#3

Post by tigerwit »

ขอบคุณครับ
ได้ปรับตามคำแนะนำผมลองหลายรอบแล้วไม่ผ่าน
พอดีเจอโค้ดอีกตัว จึงได้ผมได้ลองปรับ

Code: Select all

Sub Import2()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  Dim Sum As Integer
  Dim cHead As Integer, tHead As String
  Dim rHead As Worksheet
  Application.ScreenUpdating = False
    fileFilterPattern = "Text Files (*.txt; *.csv),*.txt;*.csv"
  fileToOpen = Application.GetOpenFilename(fileFilterPattern)
  If fileToOpen = False Then
    MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
  Else
    Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
    Set wbTextImport = ActiveWorkbook
    Set wsMaster = ThisWorkbook.Worksheets("sheet1")
'    wsMaster.Range("F6:S50", "U6:V50", "Z6:AM50", "AO6:AP50").ClearContents
    wsMaster.Range("F6:S50").ClearContents
    wsMaster.Range("U6:V50").ClearContents
    wsMaster.Range("Z6:AM50").ClearContents
    wsMaster.Range("AO6:AP50").ClearContents
   Set rHead = wbTextImport.Worksheets(1)
    cHead = Application.WorksheetFunction.CountA(wbTextImport.Worksheets(1).Range("1:1"))
    tHead = rHead.Range("F6") & "_" & rHead.Range("G6") & "_" & rHead.Range("H6") & "_" & rHead.Range("I6") _
    & "_" & rHead.Range("J6") & "_" & rHead.Range("K6") & "_" & rHead.Range("L6") & "_" & rHead.Range("M6") _
    & "_" & rHead.Range("N6") & "_" & rHead.Range("O6") & "_" & rHead.Range("P6") & "_" & rHead.Range("Q6") _
    & "_" & rHead.Range("R6") & "_" & rHead.Range("S6") & "_" & rHead.Range("U6") & "_" & rHead.Range("V6")


       
        If cHead <> 16 Then
        wbTextImport.Close False
        MsgBox ("ไฟล์ที่คุณเลือก มีจำนวน หรือ ตำแหน่ง คอลัมน์ผิดพลาด" & vbCrLf & "กรุณาตรวจสอบไฟล์ก่อนนำเข้าอีกครั้ง"), vbExclamation, "โปรดตรวจสอบ"
         
         Else
        wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
        
        wsMaster.Range("F6").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        wbTextImport.Close False
        MsgBox "นำเข้าข้อมูลนักเรียนเสร็จเรียบร้อย", vbOKOnly + vbInformation, "สถานะการนำเข้าข้อมูล"
        End If
  End If

    Range("F6").Select

    Application.ScreenUpdating = True
End Sub
แต่ยังติดอยู่ไม่สามารถ ไปต่อกรณีไฟล์นำเข้า มีคลอลัมน์ที่มีว่างกั้นอยู่ก่อนคลอลัมน์ที่ต้องการคัดลอก
จะสามารถปรับโค๊ดนี้ให้ทำงานได้อย่างไรครับ
You do not have the required permissions to view the files attached to this post.
Top
User avatar
tigerwit
Silver
Silver
Posts: 553
Joined: Wed Mar 31, 2010 10:51 pm
Location: สกลนคร
Excel Ver: 2019
Contact:
Contact tigerwit

Re: codeVB ป้องกันการนำเข้าข้อมูลผิดไฟล์

#4

Post by tigerwit »

ไฟล์ทดลองนำเข้าอีกไฟล์
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: codeVB ป้องกันการนำเข้าข้อมูลผิดไฟล์

#5

Post by snasui »

tigerwit wrote: Tue Oct 11, 2022 1:15 am แต่ยังติดอยู่ไม่สามารถ ไปต่อกรณีไฟล์นำเข้า มีคลอลัมน์ที่มีว่างกั้นอยู่ก่อนคลอลัมน์ที่ต้องการคัดลอก
จะสามารถปรับโค๊ดนี้ให้ทำงานได้อย่างไรครับ
:D กรุณาแจ้งเงื่อนไขการนำเข้ามาด้วยว่าต้องการจะตรวจสอบสิ่งใดบ้าง เมื่อตรวจสอบแล้วจะให้วางข้อมูลลักษณะใด จะได้เข้าใจตรงกันครับ
Top
User avatar
tigerwit
Silver
Silver
Posts: 553
Joined: Wed Mar 31, 2010 10:51 pm
Location: สกลนคร
Excel Ver: 2019
Contact:
Contact tigerwit

Re: codeVB ป้องกันการนำเข้าข้อมูลผิดไฟล์

#6

Post by tigerwit »

จาก Code นี้

Code: Select all

Sub Import2()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  Dim Sum As Integer
  Dim cHead As Integer, tHead As String
  Dim rHead As Worksheet
  Application.ScreenUpdating = False
    fileFilterPattern = "Text Files (*.txt; *.csv),*.txt;*.csv"
  fileToOpen = Application.GetOpenFilename(fileFilterPattern)
  If fileToOpen = False Then
    MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
  Else
    Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
    Set wbTextImport = ActiveWorkbook
    Set wsMaster = ThisWorkbook.Worksheets("sheet1")
'    wsMaster.Range("F6:S50", "U6:V50", "Z6:AM50", "AO6:AP50").ClearContents
    wsMaster.Range("F6:S50").ClearContents
    wsMaster.Range("U6:V50").ClearContents
    wsMaster.Range("Z6:AM50").ClearContents
    wsMaster.Range("AO6:AP50").ClearContents
   Set rHead = wbTextImport.Worksheets(1)
    cHead = Application.WorksheetFunction.CountA(wbTextImport.Worksheets(1).Range("1:1"))
    tHead = rHead.Range("F6") & "_" & rHead.Range("G6") & "_" & rHead.Range("H6") & "_" & rHead.Range("I6") _
    & "_" & rHead.Range("J6") & "_" & rHead.Range("K6") & "_" & rHead.Range("L6") & "_" & rHead.Range("M6") _
    & "_" & rHead.Range("N6") & "_" & rHead.Range("O6") & "_" & rHead.Range("P6") & "_" & rHead.Range("Q6") _
    & "_" & rHead.Range("R6") & "_" & rHead.Range("S6") & "_" & rHead.Range("U6") & "_" & rHead.Range("V6")
      
        If cHead <> 16 Then
        wbTextImport.Close False
        MsgBox ("ไฟล์ที่คุณเลือก มีจำนวน หรือ ตำแหน่ง คอลัมน์ผิดพลาด" & vbCrLf & "กรุณาตรวจสอบไฟล์ก่อนนำเข้าอีกครั้ง"), vbExclamation, "โปรดตรวจสอบ"
         
         Else
        wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
        
        wsMaster.Range("F6").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        wbTextImport.Close False
        MsgBox "นำเข้าข้อมูลนักเรียนเสร็จเรียบร้อย", vbOKOnly + vbInformation, "สถานะการนำเข้าข้อมูล"
        End If
  End If

    Range("F6").Select

    Application.ScreenUpdating = True
End Sub
เมื่อใช้ทดลองนำเข้า ไฟล์ .Csv (ไฟล์แนบมาชื่อชื่อ 2.Csv)
จะสามารถนำเข้าได้เพียง 14 คลอลัมน์ จากที่ต้องการนำเข้า 16 คลอลัมน์ (คลอลัมน์ที่มีตัวเลข)
จะปรับโค๊ดอย่างไร ให้สามารถนำเข้าได้ครบ 16 คลอลัมน์
และหากนำเข้าไฟล์ที่มีคลอลัมน์ ไม่ถูกต้องก็ให้แจ้งเตือนนำเข้าไม่ได้
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31176
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: codeVB ป้องกันการนำเข้าข้อมูลผิดไฟล์

#7

Post by snasui »

:D ตัวอย่าง Code สำหรับการนำเข้ามาทั้งสองพื้นที่ครับ

Code: Select all

'        If cHead <> 32 Then
'        wbTextImport.Close False
'        MsgBox ("ไฟล์ที่คุณเลือก มีจำนวน หรือ ตำแหน่ง คอลัมน์ผิดพลาด" & vbCrLf & "กรุณาตรวจสอบไฟล์ก่อนนำเข้าอีกครั้ง"), vbExclamation, "โปรดตรวจสอบ"
'
'         Else
        wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
        wsMaster.Range("F6").PasteSpecial xlPasteValues
        wbTextImport.Worksheets(1).Range("P1").CurrentRegion.Copy
        wsMaster.Range("U6").PasteSpecial xlPasteValues
        
        Application.CutCopyMode = False
        wbTextImport.Close False
        MsgBox "นำเข้าข้อมูลนักเรียนเสร็จเรียบร้อย", vbOKOnly + vbInformation, "สถานะการนำเข้าข้อมูล"
'        End If
ไฟล์ที่มีคอลัมน์ถูกต้องหรือไม่ถูกต้องจำเป็นจะต้องอธิบายมาอย่างละเอียดว่าดูตรงไหน อย่างไร ถ้าหากใช้การนับคอลัมน์ได้ Code ที่เขียนมาเองแล้วก็ย่อมต้องทำงานได้ครับ
Top
Post Reply

Return to “Excel”