从文件对话框 {文件夹] 添加文件时检查列表框是否已经有文件

Question

大家好，我在 MS Access 中创建了一个表单，我正在尝试编写一些代码来防止在将文件添加到列表框时出现重复文件。就像现在一样，如果我 select 感兴趣的文件夹并单击“显示”按钮，它会重新添加列表框中已有的相同文件。请指教。以下是我目前的代码：

    Public Sub btn_folderimp_Click()
    ' Displays Excel SpreadSheets In Selected Folder
    
        Dim myFSO As New FileSystemObject
        Dim MyFile As File
        Dim mFolder As Folder
    '   Dim lbx As ListBox
        
           
        'Checks If No Folder Was Selected
            If Nz(Me.txt_folderpath, "") = "" Then
                Beep
                MsgBox "No Folder Selected!"
                Exit Sub
            End If
        
        'Checks If Folder Exists, If Yes, it displays a list of spreadsheets in the Folder
            
            If myFSO.FolderExists(Nz(Me.txt_folderpath, "")) Then
                         
              
                Set mFolder = myFSO.GetFolder(Me.txt_folderpath)
    
                For Each MyFile In mFolder.Files
                
                            If (myFSO.GetExtensionName(MyFile.Name) = "xlsx") Then 'Or (myFSO.GetExtensionName(MyFile.Name) = "xls")
              
        
                                Me.lbx_show.AddItem MyFile.Path
    '                               Debug.Print MyFile
     
                            End If
                    
                Next MyFile
                
                           
    ' Checks if there are excel spreadsheets in the folder
    
              If Dir(Me.txt_folderpath & "*.xlsx") = "" Then
                    Beep
                    MsgBox "No Excel Spreadsheet Found!"
                    End If
              Else
                Beep
                MsgBox "Folder Does Not Exist"
              End If
       
    End Sub

Answer 1

我想你想为你在文本框中选择的每个目录添加文件到列表框，如果你运行你 post 中的代码第二次它不应该添加相同的第二次归档。您可以通过使用字典并将文件名添加到字典中来做到这一点

Option Compare Database
Option Explicit

' Dictionary for the filenames
Dim dict As New Scripting.Dictionary


Public Sub btn_folderimp_Click()
    ' Displays Excel SpreadSheets In Selected Folder
    
    Dim myFSO As New FileSystemObject
    Dim MyFile As File
    Dim mFolder As Folder
    '   Dim lbx As ListBox
        
           
    'Checks If No Folder Was Selected
    If Nz(Me.txt_folderpath, "") = "" Then
        Beep
        MsgBox "No Folder Selected!"
        Exit Sub
    End If
            
    ' clear the listbox
    lbx_show.RowSource = ""
        
    'Checks If Folder Exists, If Yes, it displays a list of spreadsheets in the Folder
            
    If myFSO.FolderExists(Nz(Me.txt_folderpath, "")) Then
                         
              
        Set mFolder = myFSO.GetFolder(Me.txt_folderpath)
    
        For Each MyFile In mFolder.Files
                
            If (myFSO.GetExtensionName(MyFile.Name) = "xlsx") Then 'Or (myFSO.GetExtensionName(MyFile.Name) = "xls")
              
                ' will add a new entry if it not exists
                dict(MyFile.Path) = MyFile.Path
                'Me.lbx_show.AddItem MyFile.Path
                
     
            End If
                    
        Next MyFile
        
        ' add the filenames to the listbox
        Dim key As Variant
        For Each key In dict.Keys
            Me.lbx_show.AddItem key
        Next
        
                           
        ' Checks if there are excel spreadsheets in the folder
    
        If Dir(Me.txt_folderpath & "*.xlsx") = "" Then
            Beep
            MsgBox "No Excel Spreadsheet Found!"
        End If
    Else
        Beep
        MsgBox "Folder Does Not Exist"
    End If
       
End Sub

从文件对话框 {文件夹] 添加文件时检查列表框是否已经有文件

Check If a Listbox Already Has Files When Adding Files From a File Dialog {Folder]

ms-access

vba