Importing Data From Legacy System Into Access 2007, Access 2007 (1 Viewer)

Option Compare Database
        Public strPathOriginal As String 'The original path to teh file location
        Public strPathWorking As String 'The path to temporary working location of the file being worked upon
        Public strPathTrouble As String 'The path to the folder for trouble files
        Public strPatheArchived As String 'The path to teh file location for archived files
        Public strFile As String 'The current file name being worked with
        Public strPath As String
        Public strPathFileOriginal As String 'The full string of the original file and location
        Public strPathFileWorking As String 'The full string of the working file and location
        Public strPathFileArchive As String 'The full string of the working file and location
        Public strPathFileTrouble As String 'The full string of the trouble file and location
        Public fs As Object
        Public strTable As String
        Public blnHasFieldNames As Boolean
        Public blnEXCEL As Boolean
        Public blnReadOnly As Boolean
        Public objExcel As Object
        Public objWorkbook As Object
        Public objWorksheet As Object
        Public VesselName As String
        

Public Function ImportData()
        'Create excel object
        On Error Resume Next
        Set objExcel = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set objExcel = CreateObject("Excel.Application")
            blnEXCEL = True
        End If
        Err.Clear
        On Error GoTo 0
                
        ' Change this next line to True if the first row in EXCEL worksheet has field names
        blnHasFieldNames = False

        ' Replace C:\Documents\ with the real path to the folder that contains the EXCEL files
        strPathOriginal = "C:\Documents\" 
        
        'Set temporary local storage for importing data from 
        strPathWorking = "C:\temp\"
        
        'Set archive location
        strPathArchived = "your archive location"
        
        'Set trouble file location
        strPathTrouble = "your problem files location"
        
        ' Replace tablename with the real name of the table into which the data are to be imported
        strTable = "ImportTable"
        
        'Get the list of files in the directory
        strFile = Dir(strPathOriginal & "*.xlsx")
        
        
        Do While Len(strFile) > 0
        strPathFileOriginal = strPathOriginal & strFile
        strPathFileWorking = strPathWorking & "Working.xlsx"
        strPathFileArchive = strPathArchived & strFile
                
        'Get the vessels name from the file name
        FirstFind = InStr(strFile, "-")
        SecondFind = InStr(FirstFind + 1, strFile, "-")
        VesselName = Trim(Mid(strFile, FirstFind + 1, SecondFind - FirstFind - 1))
        
        'MsgBox (strFile) 'Used for testing only
        
        'if vessel exists, run import routine, if not move to trouble folder
'Convert this to check if your customer exists
        If DCount("[VesselID]", "VesselData", "[VesselName] = '" & VesselName & "'") > 0 Then
        
            'copy file to working directory
                Set fs = CreateObject("Scripting.FileSystemObject")
                fs.CopyFile strPathFileOriginal, strPathFileWorking
                Set fs = Nothing
                
            'Use import function for excel operation
                ImportFromExcel
        
            'remove working copy
                Kill strPathFileWorking
                
            'copy file to archive directory
                Set fs = CreateObject("Scripting.FileSystemObject")
                fs.CopyFile strPathFileOriginal, strPathFileArchive
                Set fs = Nothing
                
            'remove original copy after copying it to the archive, remove if you do not want to delete old files
                Kill strPathFileOriginal
        
            strFile = Dir()
        
        Else
            'set trouble file location
                strPathFileTrouble = strPathTrouble & strFile
            
            'copy file to trouble directory
                Set fs = CreateObject("Scripting.FileSystemObject")
                fs.CopyFile strPathFileOriginal, strPathFileTrouble
                Set fs = Nothing
                
            'remove original copy after copying it to the archive, remove if you do not want to delete old files
                Kill strPathFileOriginal
        
            strFile = Dir()
        End If
        
        
        Loop




End Function


Public Function ImportFromExcel()
        Dim SheetVersion As String
        
        'Switch off warnings
        DoCmd.SetWarnings False
        
        'rename sheet with data
                Set objWorkbook = objExcel.workbooks.Open(strPathFileWorking, updatelinks:=0)
                objWorkbook.Sheets("Environmental data input").Name = "Working"
                SheetVersion = objWorkbook.Sheets("Working").range("G1").Value
                objWorkbook.Save
                objWorkbook.Close
                objExcel.Quit
                
                
        'Import excel sheet
                DoCmd.TransferSpreadsheet _
                acImport, _
                acSpreadsheetTypeExcel9, _
                strTable, _
                strPathFileWorking, _
                False, _
                "Working!A6:BL500"