แก้โค้ดให้แสดงรูปในซับโฟลเดอร์ยังไงครับ

[Note Ekkachai]

ในโฟลเดอร์Pictureจะมีรูปเยอะอยู่แล้ว ติดตรงที่กล้องที่ถ่ายจะบันทึกชื่อไฟล์ซ้ำกับรูปที่เคยมี

ผมเลยกำหนดให้กล้องสร้างโฟลเดอร์ขึ้นมาไว้ในโฟลเดอร์Picture โดยจะตั้งอัตโนมัติเป็นปีเดือนวัน เช่น 2018-8-18

ผมจะแก้ยังไงดีครับ โดยโค้ดที่ใช้อยู่ในปัจจุบันคือ

Option Compare Database
Option Explicit

Public Function iFileDialog() As String
 Const msoFileDialogFilePicker = 3
 Const msoFileDialogViewDetails = 2
 Dim fd As Object, varltems As Variant, flPath As Variant
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
 With fd
    .Title = "Choose"
    .InitialView = msoFileDialogViewDetails
    .Filters.Clear
    .Filters.Add "Image", "*.jpg;*.png;*.bmp"
    .Filters.Add "All Files", "*.*"
    .filterIndex = 1
    .InitialfileName = CurrentProject.Path & "\Picture"
    If fd.show = True Then
        iFileDialog = Trim(.SelectedItems.Item(1))
    End If
  End With
End Function

ขอบคุณครับ

[ปิ่นณรงค์]

.InitialfileName = CurrentProject.Path & "\Picture"
ถ้าเราสร้าง Combobox ขึ้นมาซักตัวเพื่อกำหนดให้แสดง List ของชื่อ Folderวันที่ต่างๆ ที่มีอยู่ใน Picture แล้วกดเปิดตำแหน่งของ Folder นั้นขึ้นมา เพราะท่านได้กำหนดให้แสดงใน Folder Picture แล้ว ถ้าจะกำหนดให้แสดง SubFolder ก็ควรจะมีการกำหนดชื่อของ SubFolder แล้วเปิดขึ้นมาครับ  ถ้าต้องการแบบนี้ เดี่ยวผมทำตัวอย่างให้ดู

[Note Ekkachai]

รบกวนด้วยครับอาจารย์ ขอบคุณครับ

[ปิ่นณรงค์]

ลองดูตัวอย่างนี้ครับ สมมุติมีชื่อ Folder ใน Folder Picture 2 อันแบบนี้


เมื่อเปิดฟอร์มก็จะจัดเก็บ รายชื่อ SubFolder ลงในตารางและนำมาแสดงใน Combobox


เมื่อเลือก ชื่อ SubFolder แล้วกด Open ก็จะแสดงรูปภาพทั้งหมดที่มีใน SubFolder นั้นขึ้นมาครับ


แสดงตัวอย่างโค้ดทั้งหมด

โค๊ด: [Select]

Option Compare Database
Option Explicit

 Public Function iFileDialog() As String
 Const msoFileDialogFilePicker = 3
 Const msoFileDialogViewDetails = 2
 Dim fd As Object, varltems As Variant, flPath As Variant
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
 With fd
    .Title = "Choose"
    .InitialView = msoFileDialogViewDetails
    .Filters.Clear
    .Filters.Add "Image", "*.jpg;*.png;*.bmp"
    .Filters.Add "All Files", "*.*"
    .FilterIndex = 1
    .InitialFileName = CurrentProject.Path & "\Picture\" & Me.Combo1
    If fd.Show = True Then
        iFileDialog = Trim(.SelectedItems.Item(1))
    End If
  End With
End Function
Sub Create_Dir_List(Inputpath As String)
Dim Dbs As Database
Dim Rst As DAO.Recordset
Dim Fso, Fldr, SubFldr, F As Object
Dim CurrentSubFolderName As String

Set Dbs = CurrentDb
Set Rst = Dbs.OpenRecordset("ListTable", dbOpenDynaset)
Set Fso = CreateObject("scripting.filesystemobject")
Set Fldr = Fso.getfolder(Inputpath)

CurrentSubFolderName = Right$(Fldr.Path, Len(Fldr.Path) - InStrRev(Fldr.Path, "\"))
    With Rst
        .AddNew
        .Fields("FolderName") = CurrentSubFolderName
        .Update
     End With
For Each Fldr In Fldr.subfolders
Call Create_Dir_List(Fldr.Path)
Next Fldr
End Sub
Private Sub Combo1_GotFocus()
Me.Requery
End Sub
Private Sub Find_Click()
Call iFileDialog
End Sub
Private Sub Form_Open(Cancel As Integer)
DoCmd.SetWarnings False
DoCmd.RunSQL ("delete * from Listtable")
DoCmd.SetWarnings True
Call Create_Dir_List(CurrentProject.Path & "\Picture")
End Sub



[Note Ekkachai]

ขอบคุณครับอาจารย์ที่สละเวลามาช่วยตอบ ผมลองพิจารณาวิธีที่อาจารย์แนะนำแล้วดีมากเลยครับ
เพียงแต่ผมต้องการความเร็วในการออกเอกสารผมจึงคิดอีกวิธีในการนำเข้าข้อมูลและขอสอบถามเพิ่มเติมดังนี้ครับ

ผมติดที่กล้องจะอัพรูปอัตโนมัติโดยรันเป็น IMG_0001 ไปเรื่อยๆซึ่งทับกับไฟล์รูปที่มี

ผมจึงอยากจะสร้างโฟลเดอร์ใหม่อีก 1 โฟลเดอร์แล้วให้โปรแกรมเห็นรูปทั้งโฟลเดอร์เก่าและใหม่ ซึ่งโค้ดปกติที่ผมใช้คือ

Option Compare Database
Option Explicit

Public Function iFileDialog() As String
 Const msoFileDialogFilePicker = 3
 Const msoFileDialogViewDetails = 2
 Dim fd As Object, varltems As Variant, flPath As Variant
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
 With fd
    .Title = "Choose"
    .InitialView = msoFileDialogViewDetails
    .Filters.Clear
    .Filters.Add "Image", "*.jpg;*.png;*.bmp"
    .Filters.Add "All Files", "*.*"
    .filterIndex = 1
    .InitialfileName = CurrentProject.Path & "\Picture"
    If fd.show = True Then
        iFileDialog = Trim(.SelectedItems.Item(1))
    End If
  End With
End Function

แล้วเอกสารแต่ละชุดผมจะมีรูปเพียง 3 รูป ซึ่งรูปนั้นจะถูกแสดงโดยใช้โค้ดนี้ครับ

Option Compare Database

Private Sub Command15_Click()
 Dim iPath As String
 iPath = iFileDialog
 If iPath & "" <> "" Then
  Me.Photo1 = Mid(iPath, InStrRev(iPath, "\") + 1)
 End If
End Sub

Private Sub Command16_Click()
 Dim iPath As String
 iPath = iFileDialog
 If iPath & "" <> "" Then
  Me.Photo2 = Mid(iPath, InStrRev(iPath, "\") + 1)
 End If
End Sub

Private Sub Command17_Click()
 Dim iPath As String
 iPath = iFileDialog
 If iPath & "" <> "" Then
  Me.Photo3 = Mid(iPath, InStrRev(iPath, "\") + 1)
 End If
End Sub

ผมต้องแก้ไขอะไร อย่างไรบ้างครับ

[ปิ่นณรงค์]

อ่อเดียวปรับใหม่คับ

[Note Ekkachai]

ยังรอท่านอาจารย์อยู่นะครับ หรือมีอาจารย์ท่านไหนสะดวกไหมครับ รบกวนด้วยครับ ขอบคุณครับ

[ปิ่นณรงค์]

ให้เห็นทั้งรูปจากทั้งโฟลเดอร์เก่าและใหม่ อันนี้ผมไม่เคยลองทำเลยครับที่เคยทำก็แค่ DialogPicker ในการเลือกรูป
ปัญหาที่คุยเจอคือพอกล้องอัพรูปลงไปใน Folder เดิมทำให้เกิดการเขียนทับไฟล์เก่าใช่ไหมครับ

ถ้าแบบนี้ให้โปรแกรมทำการ Copy File จาก PicTure โดยเอา SubFloder(Folder วันที่)  มารวมเป็น Folder เดียวกัน
โดยเรากำหนดให้ถ้าเจอไฟล์ซื่อซ้ำกันก็ให้ใส่ (1) (2) เหมือนของ Windows ดีไหมครับ
หรือมีวิธีอื่นๆ ต้องรออาจารย์ท่านอื่นๆ มาแนะนำครับเพราะผมไม่เคยทำเหมือนกันครับ

(ต้องขอโทษที่ตอบช้าครับผมติดสร้างโปรแกรมของหน่วยงานครับ)

[Note Ekkachai]

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