Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.databases.ms-access > #10080

Re: compacting error in code

Show all headers | View raw

On 06/11/2014 14:24:43, bobh wrote:
> On Wednesday, November 5, 2014 3:14:05 PM UTC-5, Ulrich Möller wrote:
>> Am 05.11.2014 um 20:39 schrieb bobh:
>> > Hi All,
>> >
>> > I had gotten an Access 2003 app that did a compact/repair and I liked t
> he way it was setup. I switch too Access 2007 and this app no longer runs
> a nd I have not been able to figure it out. It errors on the 'SET FS'
> line(be low) with the following message;
>> >
>> > Run-Time error 2455
>> > You entered an expression that has an invalid
>> > reference to the property FileSearch
>> >
>> >
>> >      Dim fs As FileSearch, i As Integer
>> >      Set fs = Application.FileSearch
>> >      With fs
>> >          .NewSearch
>> >          .LookIn = strRootFolder
>> >          .SearchSubFolders = True
>> >          .FileType = msoFileTypeDatabases
>> >          If .Execute > 0 Then
>> >              For i = 1 To .FoundFiles.Count
>> >                  insertDatabasePath .FoundFiles(i)
>> >              Next i
>> >          End If
>> >      End With
>> >
>> > I would surely like to get this fixed and running again using Access 20
> 07 it is a neat little app.
>> > thanks
>> > bobh.
>>
>> FilesSearch doesn't exists any more in 2007 and you have to look for a
>> replacement.
>>
>> Ulrich
> 
> are you saying that Access 2007 does not have a replacement in it?
> bobh.
> 

This may???? help

Public Function ListFiles(strPath As String, Optional strFileSpec As String,
_     Optional bIncludeSubfolders As Boolean)
    'Debug.Print ListFiles(""E:\Phil Data", "*.Csv", True)

    On Error GoTo Err_Handler
    'Purpose:   List the files in the path.
    'Arguments: strPath = the path to search.
    '           strFileSpec = "*.*" unless you specify differently.
' ' bIncludeSubfolders: If True, returns results from subdirectories of
strPath as well. ' lst: if you pass in a list box, items are added to it. If
not, files are listed to immediate window. ' The list box must have its Row
Source Type property set to Value List. 'Method: FilDir() adds items to a
collection, calling itself recursively for subfolders. Dim colDirList As New
Collection     Dim varItem As Variant
    
    Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
    
'Add 'Add the files to a list box if one was passed in. Otherwise list to the
Immediate Window.

    For Each varItem In colDirList
        Debug.Print varItem & " " & GetFileDate(CStr(varItem))
    Next
    
Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As String,
strFileSpec As String, _     bIncludeSubfolders As Boolean)
    'Debug.Print ListFiles("E:\Phil Data", "*.Csv", True)
'Build uild up a list of files, and then add add to this list, any additional
folders

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Build collection of additional subfolders.
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop
        'Call function recursively for each subfolder.
        For Each vFolderName In colFolders
Call Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName),
strFileSpec, True)         Next vFolderName
    End If
    
End Function

Public Function TrailingSlash(varIn As Variant) As String
    
    If Len(varIn) > 0& Then
        If right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    
    End If
    
End Function

Function GetFileDate(fileName As String) As Date

    Dim fs As Object, f As Object
    Set fs = CreateObject("Scripting.FileSystemObject")

    Set f = fs.GetFile(fileName)
    'Debug.Print ("File created: " & f.DateCreated)
    'GetFileDate = f.DateCreated
    'GetFileDate = f.DateLastAccessed
    GetFileDate = f.DateLastModified
    Set f = Nothing
    Set fs = Nothing
     
End Function

Phil

---
This email is free from viruses and malware because avast! Antivirus protection is active.
http://www.avast.com

Back to comp.databases.ms-access | Previous | Next — Previous in thread | Find similar | Unroll thread

Thread

compacting error in code bobh <vulcaned@yahoo.com> - 2014-11-05 11:39 -0800
  Re: compacting error in code Ulrich Möller <knobbi38@arcor.de> - 2014-11-05 21:14 +0100
    Re: compacting error in code bobh <vulcaned@yahoo.com> - 2014-11-06 06:24 -0800
      Re: compacting error in code Patrick Finucane <patrickfinucanetx@gmail.com> - 2014-11-06 06:33 -0800
        Re: compacting error in code CDMAPoster@fortunejames.com - 2014-11-06 09:36 -0800
      Re: compacting error in code "Phil" <phil@stantonfamily.co.uk> - 2014-11-06 17:15 +0000

csiph-web