สอบถามการค้นหาไฟล์ vba ครับ

[lnongkungl]

คือผมต้องการค้นหาไฟล์ที่อยู่ในโฟลเดอร์ รับเข้า ครับ แต่ถ้าไม่เจอก็สร้างไฟล์ใหม่ตามชื่อที่กำหนดครับ
แต่พอลองรันดู มันไม่เกิดอะไรขึ้นเลย รบกวนอาจารย์เช็คโค๊ดให้ทีครับว่าต้องแก้ไขตรงไหน มันไม่ error หรือ อะไรเลย ผมเลย งง

Code: Select all

Public Sub find()
Dim fname As String
fname = Format(Now(), "yyyy")
Dim fpath As String
fpath = ActiveWorkbook.Path & "\รับเข้า"
If fname = "" Then
Workbook.Add Filename:=fpath & "\" & fname
End If

[snasui]

แนบไฟล์ตัวอย่างที่เขียน Code นี้ไว้แล้วมาด้วยจะได้สะดวกในการทดสอบและแนะนำครับ

[lnongkungl]

ไฟล์ครับ ผมเอารวมไปไว้ในปุ่ม save เลยครับ แต่ code save ผมยังไม่ได้เช็ค error เอาแค่ code ตรวจสอบไฟล์ก่อนครับ

[snasui]

ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Dim fname As String
Dim fpath As String

fname = Format(Now(), "yyyy")
fpath = Dir(ActiveWorkbook.Path & "\ÃѺà¢éÒ\" & fname & ".xlsx")
Application.DisplayAlerts = False
If fpath = "" Then
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & _
        "\" & fname & ".xlsx", FileFormat:=xlOpenXMLWorkbook
End If
Application.DisplayAlerts = True

[lnongkungl]

ขอบคุณครับ อาจารย์ ผมอาจจะอธิบายไม่ค่อยเข้าใจ มันเลยยังไม่ตรงกับ concept เท่าไรครับ เด๋วผมลองเอาไปปรับดูก่อนครับ ติดตรงไหนแล้วเดี๋ยวมาถามอีกทีครับ

[snasui]

ขอบคุณครับ อาจารย์ ผมอาจจะอธิบายไม่ค่อยเข้าใจ มันเลยยังไม่ตรงกับ concept เท่าไรครับ เด๋วผมลองเอาไปปรับดูก่อนครับ ติดตรงไหนแล้วเดี๋ยวมาถามอีกทีครับ

คำว่า "เด๋ว" ผิดกฎการใช้บอร์ด ขอให้งดใช้ภาษาแชทเนื่องจากมีผู้เข้ามาศึกษาจากหลายประเทศ การแปลหน้าเว็บอาจจะทำให้ความหมายผิดไปจากที่ควรจะเป็นครับ

[lnongkungl]

ขออภัยครับ รีบพิมพ์ไปหน่อย

[OOjaoQQ]

อาจารย์ช่วยดู code ที่ผมเขียนหน่อยครับ มันติดดีบักครั้งแรก แล้วค่อยทำงานได้ครับ
กรอก พ.ศ. ในช่อง B2 ครับ ถ้าเจอไฟล์ จะเปิดไฟล์ ถ้าไม่เจอ จะเปิด Filebase แล้ว save as ตามชื่อ ที่ค้นหาครับ
มันเหมือนไม่สมบูรณ์ครับ ถ้าอาจารย์เห็นว่าตรงไหน ควรเพิ่ม หรือ แก้ กรุณาแนะนำด้วยนะครับ ขอบคุณครับ

Private Sub cmbSearch_Click()
Dim FilePath As String ' ¡Ó˹´ µÑÇá»Ã ª×èÍ Path ·Õèà¡çºä¿Åì
Dim fileName As Variant ' ¡Ó˹´ µÑÇá»Ã ª×èÍä¿Åì
Dim fileNameBase As Variant ' ¡Ó˹´ µÑÇá»Ã ª×èÍä¿Åìµé¹©ºÑº
Dim fileNameSearch As Variant ' ¡Ó˹´ µÑÇá»Ã ª×èÍä¿Åì·Õè¤é¹ËÒ
Dim strmsgbox As String ' ¡Ó˹´ µÑÇá»Ã msgbox
fileNameSearch = Sheet1.Range("B2").Value ' ´Ö§ª×èÍä¿Åì·Õè¤é¹ËÒÁÒà¡çºã¹µÑÇá»Ã
FilePath = "D:\Data" ' ·Õèà¡çºä¿Åì
fileName = Dir(FilePath & "\*.xlsm") ' ä¿Åìáá
fileNameBase = Dir(FilePath & "\*.xlsm") ' ä¿Åìµé¹©ºÑº ª×èÍ
' ==== µÃǨÊͺÇèÒÁÕä¿ÃìËÃ×ÍäÁè
Do Until fileName = "" ' µÃǨÊͺä¿Å·ÕÅÐä¿Åì
If fileName = Trim(fileNameSearch & ".xlsm") Then ' ¶éÒà¨Íä¿Åì·Õè¤é¹ËÒ
Workbooks.Open (fileNameSearch & ".xlsm")






Exit Sub ' ¨º¡Ò÷ӧҹ
fileName = Dir() ' àÅ×è͹ä¿Åì¶Ñ´ä»
End If
fileName = Dir() ' àÅ×è͹ä¿Åì¶Ñ´ä»
Loop
' ==== ¶éÒäÁèãËéÊÃéÒ§ä¿ÃìãËÁè
'Workbooks.Open (fileNameBase) 'à»Ô´ - ä¿Åìµé¹©ºÑº
Dim MyFile As Variant
MyFile = Dir(FilePath & "\Filebase.xlsm")
Workbooks.Open (MyFile)
'Workbooks.Open (fileNameBase)
Dim fileSaveName As Variant
ActiveWorkbook.SaveAs fileName:=fileNameSearch ' Save ä¿Åìµé¹©ºÑº µÒÁª×èÍ ·Õè¤é¹ËÒ
ActiveWorkbook.Close '»Ô´ä¿Åì
strmsgbox = msgbox(fileNameSearch & " ¶Ù¡ÊÃéÒ§àÃÕºÃéÍÂáÅéÇ...¤ÃѺ!!", , "á¨é§àµ×͹")
End Sub

[snasui]

กรุณาโพสต์ Code ให้แสดงเป็น Code ดูตัวอย่างในกฎการใช้บอร์ดข้อ 5 ด้านบน จะได้สะดวกในการอ่านและคัดลอกไปทดสอบครับ

หากมีภาษาไทยใน Code ให้สลับคีย์บอร์ดเป็นภาษาไทยก่อนแล้วค่อยคัดลอกมาวางในช่องความเห็น

กรณีเป็นคำถามที่ไม่เกี่ยวข้องกับกระทู้เดิมให้ตั้งกระทู้ขึ้นมาใหม่ครับ

[OOjaoQQ]

ขอโทษครับ อาจารย์ช่วยดู code ที่ผมเขียนหน่อยครับ มันติดดีบักครั้งแรก แล้วค่อยทำงานได้ครับ
กรอก พ.ศ. ในช่อง B2 ครับ ถ้าเจอไฟล์ จะเปิดไฟล์ ถ้าไม่เจอ จะเปิด Filebase แล้ว save as ตามชื่อ ที่ค้นหาครับ
มันเหมือนไม่สมบูรณ์ครับ ถ้าอาจารย์เห็นว่าตรงไหน ควรเพิ่ม หรือ แก้ กรุณาแนะนำด้วยนะครับ ขอบคุณครับ





Private Sub cmbSearch_Click()
Dim FilePath As String
Dim fileName As Variant
Dim fileNameBase As Variant
Dim fileNameSearch As Variant
Dim strmsgbox As String
fileNameSearch = Sheet1.Range("B2").Value
FilePath = "D:\Data"
fileName = Dir(FilePath & "\*.xlsm")
fileNameBase = Dir(FilePath & "\*.xlsm")
Do Until fileName = ""
If fileName = Trim(fileNameSearch & ".xlsm") Then
Workbooks.Open (fileNameSearch & ".xlsm")


Exit Sub
fileName = Dir()
End If
fileName = Dir()
Loop

Dim MyFile As Variant
MyFile = Dir(FilePath & "\Filebase.xlsm")
Workbooks.Open (MyFile)

Dim fileSaveName As Variant
ActiveWorkbook.SaveAs fileName:=fileNameSearch
ActiveWorkbook.Close
strmsgbox = msgbox(fileNameSearch & " ถูกสร้างเรียบร้อยแล้ว...ครับ!!", , "แจ้งเตือน")
End Sub

[snasui]

โพสต์ Code ให้เแสดงเป็น Code ด้วย ทบทวนสิ่งที่ผมแจ้งไปตามโพสต์ #9 อีกครั้งครับ

[OOjaoQQ]

อีกครั้งครับ ขอโทษครับ อาจารย์ช่วยดู code ที่ผมเขียนหน่อยครับ มันติดดีบักครั้งแรก แล้วค่อยทำงานได้ครับ
กรอก พ.ศ. ในช่อง B2 ครับ ถ้าเจอไฟล์ จะเปิดไฟล์ ถ้าไม่เจอ จะเปิด Filebase แล้ว save as ตามชื่อ ที่ค้นหาครับ
มันเหมือนไม่สมบูรณ์ครับ ถ้าอาจารย์เห็นว่าตรงไหน ควรเพิ่ม หรือ แก้ กรุณาแนะนำด้วยนะครับ ขอบคุณครับ

Code: Select all

Private Sub cmbSearch_Click()
Dim FilePath As String
Dim fileName As Variant
Dim fileNameBase As Variant
Dim fileNameSearch As Variant
Dim strmsgbox As String
fileNameSearch = Sheet1.Range("B2").Value
FilePath = "D:\Data"
fileName = Dir(FilePath & "\*.xlsm")
fileNameBase = Dir(FilePath & "\*.xlsm")
Do Until fileName = ""
If fileName = Trim(fileNameSearch & ".xlsm") Then
Workbooks.Open (fileNameSearch & ".xlsm")


Exit Sub
fileName = Dir()
End If
fileName = Dir()
Loop

Dim MyFile As Variant
MyFile = Dir(FilePath & "\Filebase.xlsm")
Workbooks.Open (MyFile)

Dim fileSaveName As Variant
ActiveWorkbook.SaveAs fileName:=fileNameSearch
ActiveWorkbook.Close
strmsgbox = msgbox(fileNameSearch & " ถูกสร้างเรียบร้อยแล้ว...ครับ!!", , "แจ้งเตือน")

[snasui]

ปรับ Code การเปิดไฟล์ใหม่เป็นด้านล่างครับ

Workbooks.Open (FilePath & "\" & MyFile)

[OOjaoQQ]

อาจารย์ครับ พอแก้ Code ตามที่อาจารย์ แนะนำ Code ที่ search file ไม่ทำงานครับ

1.jpg (32.05 KiB) Viewed 400 times

[snasui]

ถ้าทำงานมันจะให้ผลเป็นอย่างไรครับ

ภาพการฟ้องที่แนบมาหมายถึงไฟล์นั้นมีอยู่แล้ว หากต้องการ Save ทับไฟล์เดิมให้คลิก Yes ครับ

[OOjaoQQ]

ถ้าเจอไฟล์ ให้เปิดไฟล์ ถ้าไม่เจอ ให้เปิด file base แล้ว save ตามชื่อที่ค้นหาครับ

[snasui]

Code นั้นมันก็ทำเช่นอธิบายมาครับ

มันไม่เจอ Filebase.xlsm มันจึงไม่เปิด และมันจะ Save ไฟล์ปัจจุบันเป็นตามชื่อที่กำหนดในเซลล์ B2 แต่พบว่ามีไฟล์ชื่อนั้นอยู่แล้วจึงฟ้องขึ้นมา ลองทบทวนสิ่งที่ผมอธิบายไปว่าตรงตามนั้นหรือไม่

สิ่งสำคัญอย่างหนึ่งสำหรับการใช้ Code คือการตรวจสอบการทำงานของ Code ที่ละบรรทัดได้ด้วยการ Debug วิธีการคือ คลิกลงไปใน Code นั้นแล้วกดแป้น F8 ซ้ำ ๆ ลองตรวจสอบดูว่าผิดพลาดในบรรทัดไหน ขั้นตอนไหน ช่วยแจ้งบรรทัดนั้น ขั้นตอนนั้นมาครับ

[OOjaoQQ]

บรรทัดนี้ครับ ที่ผมเขียนแล้วมันไม่ทำงาน ถ้าเจอไฟล์ต้องเปิดไฟล์ อาจารย์กรุณาแนะนำด้วยครับ ต้องปรับ code อย่างไร

2.jpg (46.64 KiB) Viewed 391 times

[snasui]

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

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