asked on

Alternative for Application.Filesearch in Office 2010 - VBA

I am pasting a code block below.. Which uses some iteration withing Application.Filesearch. Could anyone edit the code for me to make it work in 2010. I hope Application.Filesearch does not work in office 2010. It would be helpful to know some comments on the code.

Private Sub FichImporte_GotFocus()
Dim CSql As String
Dim rst As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim intLenRep As Integer
Dim intLen As Integer

Set cnn = CurrentProject.Connection

intLenRep = Len(stRepCh)

    cnn.Execute "DELETE FROM FICHIERS_TROUVES"

    Set rst = New ADODB.Recordset
    Set rs1 = New ADODB.Recordset

    'Active la connection de la base Access
    Set rst.ActiveConnection = cnn
    CSql = "FICHIERS_TROUVES;"

    'Ouvre le recordset qui correspond à la table ci-dessous.
    rst.Open CSql, , adOpenKeyset, adLockOptimistic

    With Application.FileSearch
        'Débute une nouvelle recherche
        .NewSearch
        'Définit les critères de recherche
        .LookIn = stRepCh
        .FileName = "*.*"
        .SearchSubFolders = True
    End With


With Application.FileSearch
    'Exécute la recherche
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                'TextBox.Value = .FoundFiles(i)
                intLen = Len(.FoundFiles(i))
                stFichier = Right(.FoundFiles(i), intLen - intLenRep)
                'Call ShowFileInfo(.FoundFiles(i))
                With rst
                    If Right(stFichier, 11) <> "_traite.xls" Then
                        .AddNew
                            .Fields(1) = stFichier
                            '.Fields(2) = s
                        .Update
                    End If
                End With
                
                
            Next i
        End If
End With
        FichImporte.Requery

End Sub

Open in new window

MINDSUPERB

See the link below:

http://vbadud.blogspot.com/2010/02/office-2010-applicationfilesearch-error.html

It has work around solutions on this issue.

Sincerely,
Ed

SOLUTION

Rory Archibald

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

ASKER CERTIFIED SOLUTION

andrewssd3

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

VBAlearner2010

ASKER

Thank you MINDSUPERB

Thank You RORYA

Thank you andrewssd3.

I am changing the code to see if it works.. Will keep you posted on the result shortly.

VBAlearner2010

ASKER

@andrewssd3 i have added reference as you said and added the code in the new class module... But i see lots of red lines in the code.. Can you see if you have missed any syntax for the class module and confirm me. I am very new to coding and and i am stuck now...

Also it could be helpful to know how to call the class module in the second coding part.

Thanks in advance for your help.

VBAlearner2010

ASKER

@rorya

I have declared stFichier as Filesystemobject

Still i get the below part of code in red colour starting from Dowhile.. Can you help?

stFichier = Dir(stRepCh & "*.*")
   Do While stFichier <> ""
      With rst
         If Right(stFichier, 11) <> "_traite.xls" Then
            .AddNew
            .Fields(1) = stFichier
            '.Fields(2) = s
            .Update
         End If
      End With
      stFichier = Dir
   Loop

Open in new window

Rory Archibald

>>"I have declared stFichier as Filesystemobject"

Why? It's a String just as it was before.

VBAlearner2010

ASKER

Dint had the same result even before i declared. Kindly check and tel me what could be the problem.

Rory Archibald

Just tested quickly and it works fine for me - there's certainly nothing syntactically wrong with it. What error are you getting?

Rory Archibald

PS Not really sure what you mean by "Dint".

VBAlearner2010

ASKER

Oh I am sorry Rorya.. It was a typo. I am using french keyboard and english keyboard alternatively which is confusing me.

Regarding the error you said I get red lines on the code. I am retyping it instead of copy paste. WIll let you know shortly on the result.

VBAlearner2010

ASKER

It looks fine rorya.. Thank you.. But i have not checked the output yet.. Will keep you posted.

VBAlearner2010

ASKER

@andrewssd3 : Your class and solutioon is really amazing.. I have corrected the red lines now.. I will have to check the whole functionality witht the code and keep you posted on it. And thanks a ton for this wonderful code.. I am confident that it will work wonders for me.

andrewssd3

Thanks - it does not do absolutely everything you could do with Fileseach, but it did work for all the cases that were actrually being used in my company - most people just use it like you to retrieve a list of files of by certain criteria.

VBAlearner2010

ASKER

Perfect solutions by Rorya and andrewssd3

VBAlearner2010

ASKER

@andrewssd3: One more help on the same thread. Could you please simply your class only for Application.Flesearch alone and send me.

I would be of great help if you do that for me.

If i put all the functionalities of File search they dont need. So please simplify your class just for Application.filesearch.

I have to replace the below code now.

Function LastFileSaved(sFileDir As String, DebutNomFichier As String, Optional sType As String = "*.*") As String

Dim fs
Set fs = Application.FileSearch
With fs
    .LookIn = sFileDir
    .Filename = DebutNomFichier
    
    If .Execute(SortBy:=msoSortByLastModified, _
        SortOrder:=msoSortOrderDescending) > 0 Then
        LastFileSaved = .FoundFiles(1)
    Else
        MsgBox "There were no files found in:" & vbLf & _
        sFileDir & vbLf & _
        "Type: " & sType
      LastFileSaved = vbNullString
    End If
End With

End Function

Open in new window

andrewssd3

You should really post this as a new question, but I can't really simplify the code - it would be difficult to pull out some of the properties and methods and leave the others. It's just the same principle as before - add the clsFileSearch, add the references, the change the code you posted very simply like this:

Function LastFileSaved(sFileDir As String, DebutNomFichier As String, Optional sType As String = "*.*") As String

Dim fs As clsFileSearch               ' CHANGED LINE
Set fs = new clsFileSearch          'CHANGED LINE
With fs
    .LookIn = sFileDir
    .Filename = DebutNomFichier
    
    If .Execute(SortBy:=msoSortByLastModified, _
        SortOrder:=msoSortOrderDescending) > 0 Then
        LastFileSaved = .FoundFiles(1)
    Else
        MsgBox "There were no files found in:" & vbLf & _
        sFileDir & vbLf & _
        "Type: " & sType
      LastFileSaved = vbNullString
    End If
End With

End Function

Open in new window

It's just 2 lines to change. If you need a specific code solution for this instance, like the one rorya provided earlier, you really must raise a new question, and I'm sure someone (maybe even me) will oblige. My code was meant to be generic, so it's necessarily relatively complex.

VBAlearner2010

ASKER

andrewssd3:Thank you very much. I will definetely raise it as new question from now.. I am new to this forum so i did not understand it...

Anyways thank you so much. It helped a lot.