none
How to use an Array in Office 2010 to replace FileSearch RRS feed

  • Question

  • I have modified the Import procedure from http://www.datawright.com.au/access_resources/access_import_text_files.htm and the FileExist procedure from http://allenbrowne.com.

    I believe the Import procedure was created prior to Office 2010 because I cannot get the With Application.FileSearch to work. I am not familiar how to create an array to replicate the following and would appreciate some help.

    Function ImportTXTFiles()
    ' Code used from http://www.datawright.com.au/access_resources/access_import_text_files.htm
    
       Dim FilesToProcess As Integer
       Dim i As Integer
       Dim bArchiveFiles As Boolean
       Dim sFileName As String
       Dim sOutFile As String
    '   Dim DEST_TABLE As String
    '   Dim IMPORT_SPEC As String
       
       Const TOP_FOLDER = "C:\KYDNR\SME90\Import_Files" 'adjust folder name to suit
       Const ARCHIVE_FOLDER = "C:\KYDNR\SME90\Import_Files\Old" 'adjust folder name to suit
    
       Const PATH_DELIM = "\"
    
       'set to False if you DON'T want to move imported files to new folder
       bArchiveFiles = True
    
       'the FileSearch object lets you search a folder and, optionally its subfolders,
       'for files of a defined type. It loads the names of all found files into an array,
       'which we can use to import those files.
       With Application.FileSearch
         .NewSearch
         .LookIn = TOP_FOLDER
         .SearchSubFolders = False 'we only want to search the top folder
         .filename = "*.txt" 'change this to suit your needs
         .Execute
         FilesToProcess = .FoundFiles.Count
    
         'check that files have been located. If not, display message and exit routine.
         If FilesToProcess = 0 Then
           MsgBox "No files found, nothing processed", vbExclamation
           Exit Function
         End If
    
         For i = 1 To FilesToProcess
         
         
         If FileExists("C:\KYDNR\SME90\Import_Files\Section16_5_Locations.txt") Then
           'import each file
           DoCmd.TransferText acImportDelim, "GW_Locations_Import_Specs", "Section16_5_Locations", _
             .FoundFiles(i), True
           'archive the imported files
           If bArchiveFiles Then
             'code for archiving imported files...
             sFileName = StrRev(Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4))
             sFileName = Left(sFileName, InStr(1, sFileName, PATH_DELIM) - 1)
             sFileName = StrRev(sFileName)
             sOutFile = ARCHIVE_FOLDER & PATH_DELIM & sFileName & " " _
               & Format(Date, "yyyymmdd") & ".txt"
             FileCopy .FoundFiles(i), sOutFile
             Kill .FoundFiles(i)
           End If
          End If
          
         If FileExists("C:\KYDNR\SME90\Import_Files\Section16_5_Data.txt") Then
           'import each file
           DoCmd.TransferText acImportDelim, "GW_Data_Import_Specs", "Section16_5_Data", _
             .FoundFiles(i), True
           'archive the imported files
           If bArchiveFiles Then
             'code for archiving imported files...
             sFileName = StrRev(Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4))
             sFileName = Left(sFileName, InStr(1, sFileName, PATH_DELIM) - 1)
             sFileName = StrRev(sFileName)
             sOutFile = ARCHIVE_FOLDER & PATH_DELIM & sFileName & " " _
               & Format(Date, "yyyymmdd") & ".txt"
             FileCopy .FoundFiles(i), sOutFile
             Kill .FoundFiles(i)
           End If
          End If
          
         If FileExists("C:\KYDNR\SME90\Import_Files\Section17_5_Locations.txt") Then
           'import each file
           DoCmd.TransferText acImportDelim, "SW_Locations_Import_Specs", "Section17_5_Locations", _
             .FoundFiles(i), True
           'archive the imported files
           If bArchiveFiles Then
             'code for archiving imported files...
             sFileName = StrRev(Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4))
             sFileName = Left(sFileName, InStr(1, sFileName, PATH_DELIM) - 1)
             sFileName = StrRev(sFileName)
             sOutFile = ARCHIVE_FOLDER & PATH_DELIM & sFileName & " " _
               & Format(Date, "yyyymmdd") & ".txt"
             FileCopy .FoundFiles(i), sOutFile
             Kill .FoundFiles(i)
           End If
          End If
          
         If FileExists("C:\KYDNR\SME90\Import_Files\Section17_5_Data.txt") Then
           'import each file
           DoCmd.TransferText acImportDelim, "SW_Data_Import_Specs", "Section17_5_Data", _
             .FoundFiles(i), True
           'archive the imported files
           If bArchiveFiles Then
             'code for archiving imported files...
             sFileName = StrRev(Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4))
             sFileName = Left(sFileName, InStr(1, sFileName, PATH_DELIM) - 1)
             sFileName = StrRev(sFileName)
             sOutFile = ARCHIVE_FOLDER & PATH_DELIM & sFileName & " " _
               & Format(Date, "yyyymmdd") & ".txt"
             FileCopy .FoundFiles(i), sOutFile
             Kill .FoundFiles(i)
           End If
          End If
           
         Next i
       End With
    End Function
    
    
    Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
        'Purpose:   Return True if the file exists, even if it is hidden.
        'Arguments: strFile: File name to look for. Current directory searched if no path included.
        '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
        'Note:      Does not look inside subdirectories for the file.
        'Author:    Allen Browne. http://allenbrowne.com June, 2006.
        Dim lngAttributes As Long
    
        'Include read-only files, hidden files, system files.
        lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)
    
        If bFindFolders Then
            lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
        Else
            'Strip any trailing slash, so Dir does not look inside the folder.
            Do While Right$(strFile, 1) = "\"
                strFile = Left$(strFile, Len(strFile) - 1)
            Loop
        End If
    
        'If Dir() returns something, the file exists.
        On Error Resume Next
        FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
    End Function
    
    Function FolderExists(strPath As String) As Boolean
        On Error Resume Next
        FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
    End Function
    
    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 StrRev(sData As String) As String
    ' Code used from http://www.datawright.com.au/access_resources/access_import_text_files.htm
    
       Dim i As Integer
       Dim sOut As String
       sOut = ""
       For i = 1 To Len(sData)
          sOut = Mid(sData, i, 1) & sOut
       Next i
       StrRev = sOut
    End Function
    
    


    jim neal

    Friday, September 23, 2016 3:38 PM

Answers

  • Hi JamesNeal,

    The link for the Allenbrowne.com is broken. so don't know which file exist procedure you got from there.

    you had mentioned that,"I believe the Import procedure was created prior to Office 2010 because I cannot get the With Application.FileSearch to work. "

    I try to search and find that .FileSearch is not available to use.

    so you can try to use the code mentioned below to search files in folder.

    Sub LoopThroughFiles()
        Dim MyObj As Object, MySource As Object, file As Variant
       file = Dir("c:\testfolder\")
       While (file <> "")
          If InStr(file, "test") > 0 Then
             MsgBox "found " & file
             Exit Sub
          End If
         file = Dir
      Wend
    End Sub

    another approach to loop through all files in folder and find file.

    Dim strFileName As String
    'TODO: Specify path and file spec
    Dim strFolder As String: strFolder = "C:\temp\"
    Dim strFileSpec As String: strFileSpec = strFolder & "*.*"
    strFileName = Dir(strFileSpec)
    Do While Len(strFileName) > 0
        'TODO: replace Debug.Print by the process you want to do on the file
        'Dim strFilePath As String: strFilePath = strFolder & strFileName
        Debug.Print strFileName
        strFileName = Dir
    Loop
    

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Monday, September 26, 2016 6:06 AM
    Moderator