Change of code between 2003 and 2007 to import xls files to Access

[kknb4591]

Hi,

I found a great bit of code which imports xls files to Access but it only works in Access 2003. Apparently the Application.Filesearch is not present in 2007. Does anyone know how what code I would use to do the same function?

I'd greatly appreciate any help.

Function ImportXLSFiles()
Dim FilesToProcess As Integer
Dim i As Integer
Dim bArchiveFiles As Boolean
Dim sFileName As String
Dim sOutFile As String
Const TOP_FOLDER = "H:\Test" 'adjust folder name to suit
Const ARCHIVE_FOLDER = "H:\Test\Imported" 'adjust folder name to suit
Const DEST_TABLE = "tblUsers" 'change to suit
Const IMPORT_SPEC = "XLS_Import_Spec" 'change to suit
Const PATH_DELIM = "\"

bArchiveFiles = True 'set to False if you DON'T want to move imported files to new folder

With Application.FileSearch
.NewSearch
.LookIn = TOP_FOLDER
.SearchSubFolders = False 'we only want to search the top folder
.Filename = "*.xls"
.Execute
FilesToProcess = .FoundFiles.Count

'check that files have been located
If FilesToProcess = 0 Then
MsgBox "No files found, nothing processed", vbExclamation
Exit Function
End If

For i = 1 To FilesToProcess
'import each file
DoCmd.TransferText acImportDelim, IMPORT_SPEC, DEST_TABLE, .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") & ".csv"
FileCopy .FoundFiles(i), sOutFile
Kill .FoundFiles(i)
End If
Next i
End With
End Function

Function StrRev(sData As String) As String
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

 

[vbaInet]

This thread should give you some ideas:

http://www.access-programmers.co.uk/forums/showthread.php?t=116652

 

[kknb4591]

Thanks I tried a few of those solutions and none would work when executed. I'm very new to Access Macros and probably messed up the code.

Any further help would be greatly appreciated.

 

[vbaInet]

Here's your amended code. I've not tested it but hopefully there will be no syntax errors:

Function ImportXLSFiles()
    Dim bArchiveFiles As Boolean
    Dim sFileName As String
    Dim sOutFile As String
    Dim strDir As String
    
    Const TOP_FOLDER = "H:\Test" 'adjust folder name to suit
    Const ARCHIVE_FOLDER = "H:\Test\Imported" 'adjust folder name to suit
    Const DEST_TABLE = "tblUsers" 'change to suit
    Const IMPORT_SPEC = "XLS_Import_Spec" 'change to suit
    Const PATH_DELIM = "\"
    
    bArchiveFiles = True 'set to False if you DON'T want to move imported files to new folder
    
    strDir = Dir(TOP_FOLDER)
    
    If strDir = vbNullString Then
        MsgBox "No files found, nothing processed", vbExclamation
        Exit Function
    End If
    
    Do
    'import each file
        DoCmd.TransferText acImportDelim, IMPORT_SPEC, DEST_TABLE, strDir, True
        'archive the imported files
        If bArchiveFiles Then
            'code for archiving imported files...
            sFileName = StrRev(Left(strDir, Len(strDir) - 4))
            sFileName = Left(sFileName, InStr(1, sFileName, PATH_DELIM) - 1)
            sFileName = StrRev(sFileName)
            sOutFile = ARCHIVE_FOLDER & PATH_DELIM & sFileName & " " & Format(Date, "yyyymmdd") & ".csv"
            FileCopy strDir, sOutFile
            Kill strDir
        End If
        strDir = Dir    ' get next file
    Loop While strDir <> vbNullString
End Function

 

[kknb4591]

Thanks will give it a try