Page 1 of 1
สอบถามการค้นหาไฟล์ vba ครับ
Posted: Wed Dec 27, 2017 4:55 pm
by 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
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Wed Dec 27, 2017 5:03 pm
by snasui

แนบไฟล์ตัวอย่างที่เขียน Code นี้ไว้แล้วมาด้วยจะได้สะดวกในการทดสอบและแนะนำครับ
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Thu Dec 28, 2017 1:17 pm
by lnongkungl
ไฟล์ครับ ผมเอารวมไปไว้ในปุ่ม save เลยครับ แต่ code save ผมยังไม่ได้เช็ค error เอาแค่ code ตรวจสอบไฟล์ก่อนครับ
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Thu Dec 28, 2017 4:14 pm
by 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
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Fri Dec 29, 2017 9:20 am
by lnongkungl
ขอบคุณครับ อาจารย์ ผมอาจจะอธิบายไม่ค่อยเข้าใจ มันเลยยังไม่ตรงกับ concept เท่าไรครับ เด๋วผมลองเอาไปปรับดูก่อนครับ ติดตรงไหนแล้วเดี๋ยวมาถามอีกทีครับ
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Fri Dec 29, 2017 9:50 pm
by snasui
lnongkungl wrote:ขอบคุณครับ อาจารย์ ผมอาจจะอธิบายไม่ค่อยเข้าใจ มันเลยยังไม่ตรงกับ concept เท่าไรครับ เด๋วผมลองเอาไปปรับดูก่อนครับ ติดตรงไหนแล้วเดี๋ยวมาถามอีกทีครับ

คำว่า "เด๋ว" ผิดกฎการใช้บอร์ด ขอให้งดใช้ภาษาแชทเนื่องจากมีผู้เข้ามาศึกษาจากหลายประเทศ การแปลหน้าเว็บอาจจะทำให้ความหมายผิดไปจากที่ควรจะเป็นครับ
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Wed Jan 03, 2018 8:52 am
by lnongkungl
ขออภัยครับ รีบพิมพ์ไปหน่อย
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Fri Jun 15, 2018 2:27 pm
by 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
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Fri Jun 15, 2018 6:49 pm
by snasui

กรุณาโพสต์ Code ให้แสดงเป็น Code ดูตัวอย่างในกฎการใช้บอร์ดข้อ 5 ด้านบน จะได้สะดวกในการอ่านและคัดลอกไปทดสอบครับ
หากมีภาษาไทยใน Code ให้สลับคีย์บอร์ดเป็นภาษาไทยก่อนแล้วค่อยคัดลอกมาวางในช่องความเห็น
กรณีเป็นคำถามที่ไม่เกี่ยวข้องกับกระทู้เดิมให้ตั้งกระทู้ขึ้นมาใหม่ครับ
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Fri Jun 15, 2018 11:38 pm
by 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
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Fri Jun 15, 2018 11:50 pm
by snasui

โพสต์ Code ให้เแสดงเป็น Code ด้วย ทบทวนสิ่งที่ผมแจ้งไปตามโพสต์ #9 อีกครั้งครับ
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Sat Jun 16, 2018 12:06 am
by 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 & " ถูกสร้างเรียบร้อยแล้ว...ครับ!!", , "แจ้งเตือน")
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Sat Jun 16, 2018 5:38 am
by snasui

ปรับ Code การเปิดไฟล์ใหม่เป็นด้านล่างครับ
Workbooks.Open (FilePath & "\" & MyFile)
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Sat Jun 16, 2018 10:24 am
by OOjaoQQ
อาจารย์ครับ พอแก้ Code ตามที่อาจารย์ แนะนำ Code ที่ search file ไม่ทำงานครับ

- 1.jpg (32.05 KiB) Viewed 398 times
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Sat Jun 16, 2018 10:31 am
by snasui

ถ้าทำงานมันจะให้ผลเป็นอย่างไรครับ
ภาพการฟ้องที่แนบมาหมายถึงไฟล์นั้นมีอยู่แล้ว หากต้องการ Save ทับไฟล์เดิมให้คลิก Yes ครับ
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Sat Jun 16, 2018 10:37 am
by OOjaoQQ
ถ้าเจอไฟล์ ให้เปิดไฟล์ ถ้าไม่เจอ ให้เปิด file base แล้ว save ตามชื่อที่ค้นหาครับ
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Sat Jun 16, 2018 10:42 am
by snasui

Code นั้นมันก็ทำเช่นอธิบายมาครับ
มันไม่เจอ Filebase.xlsm มันจึงไม่เปิด และมันจะ Save ไฟล์ปัจจุบันเป็นตามชื่อที่กำหนดในเซลล์ B2 แต่พบว่ามีไฟล์ชื่อนั้นอยู่แล้วจึงฟ้องขึ้นมา ลองทบทวนสิ่งที่ผมอธิบายไปว่าตรงตามนั้นหรือไม่
สิ่งสำคัญอย่างหนึ่งสำหรับการใช้ Code คือการตรวจสอบการทำงานของ Code ที่ละบรรทัดได้ด้วยการ Debug วิธีการคือ คลิกลงไปใน Code นั้นแล้วกดแป้น F8 ซ้ำ ๆ ลองตรวจสอบดูว่าผิดพลาดในบรรทัดไหน ขั้นตอนไหน ช่วยแจ้งบรรทัดนั้น ขั้นตอนนั้นมาครับ
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Sat Jun 16, 2018 10:54 am
by OOjaoQQ
บรรทัดนี้ครับ ที่ผมเขียนแล้วมันไม่ทำงาน ถ้าเจอไฟล์ต้องเปิดไฟล์ อาจารย์กรุณาแนะนำด้วยครับ ต้องปรับ code อย่างไร

- 2.jpg (46.64 KiB) Viewed 389 times
Re: สอบถามการค้นหาไฟล์ vba ครับ
Posted: Sat Jun 16, 2018 11:08 am
by snasui

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