Need help with TimeStamped File Import

[E_DPSG]

Hello all experts -

I am trying to figure out the best way to do the following:
Import an system generated report (Exported to a directory every hour) into a master table.
The file naming structure is as follows:

\\MyDir\ReportName1.DDMMYYYY.HHMMSS.xls

Where MyDir = the directory structure (shared network drive)
ReportName1 = The name of the report
DDMMYYYY =the day the report was generated
HHMMSS - the time the report was generated

What I need to do is import each of the files that have not previously been imported. I do not want to have multiple linked tables, just a single master with two additional fields - as you can guess - the date and the time in two fields. I would think that these two fields would be able to be used as a check for the [iif file previously imported] statement.

I am fairly good with VBA, but when it comes to importing multiple files like this, I am horrible and need some guidance/help.

 

[HiTechCoach]

I don't have much time. Going into a meeting.

To get you started you can use the DIR() to get the fiel names.

What I normally do is use teh DIR to get a file name. I use VBA code to import the file. After importing I move the file or rename the file to have a different extension. This way I know it has been processed. I call the DIR() to get teh next file. Repeat until all files have been processed.

 

[E_DPSG]

hey Coach - I ended up doing some work with dir() function and got it to work. Sorry for the late reply. I locked myself in a room at the office and worked this out.

In short, I am looping through the directory and finding only the files I want. I copy the file, including only the sheets I need, and save the new copy in a 'staging' directory. I then link into the staged files - removing existing links as needed, pull the data into my master table based on the time of day - call to time() and checking it against the file names (first 2 digits of the serial timestamp) and the files that are available. I will post the code here soon. It is all on our citrix side of the house and I am at home catching up on the boards.

When the macro is processed, it also clears out the staging directory to ensure only valid files are processed.

Again, will post code but I appreciate your response

 

[HiTechCoach]

Thanks for the update.

Great job getting it to work.

Glad I could point you in the right direction!

 

[E_DPSG]

Well, Long overdue, but I did say I would post some code segments:

Here is the complete module used in Access and called from a macro:

Option Compare Database
Function LinkOMatic()
Dim str As String
Dim myDate As Date
Dim sFile As String
Dim sDate As Date
Dim StageDir As String
Dim DestinationDir As String

StageDir = "Source Directory Goes Here"  
' DestinationDir makes a copy of the source file, and moves it to
' a location so that you can link to the file without worry of alteration.
 DestinationDir =  "Your Destination Directory"
DeleteAllFiles (DestinationDir)
  sFile = Dir(StageDir & "SECMKT_RPROD_Locks*.xls")
    Do Until sFile = ""
        myDate = CDate(Mid$(sFile, 24, 2) & "/" & Mid$(sFile, 26, 2) & "/" & Mid$(sFile, 20, 4))
        If myDate = Date Then
            FileCopy StageDir & sFile, DestinationDir & sFile
        End If
        sFile = Dir()
    Loop
    Call LInkFiles(DestinationDir)
End Function
Function fExistTable(strTableName As String) As Integer
Dim db As Database
Dim i As Integer
    Set db = DBEngine.Workspaces(0).Databases(0)
    fExistTable = False
    db.TableDefs.Refresh
    For i = 0 To db.TableDefs.Count - 1
        If strTableName = db.TableDefs(i).Name Then
            fExistTable = True
            Exit For
        End If
    Next i
    Set db = Nothing
End Function
Function fIsFileDIR(stPath As String, _
                    Optional lngType As Long) _
                    As Integer
    On Error Resume Next
    fIsFileDIR = Len(Dir(stPath, lngType)) > 0
End Function
Public Function DeleteAllFiles(ByVal FolderSpec As String) _
  As Boolean
    Dim oFS As New FileSystemObject
    Dim oFolder As Folder
    Dim oFile As File
    If oFS.FolderExists(FolderSpec) Then
        Set oFolder = oFS.GetFolder(FolderSpec)
        On Error Resume Next
        For Each oFile In oFolder.Files
            oFile.Delete True
        Next
        DeleteAllFiles = oFolder.Files.Count = 0
    End If
End Function
Public Function LInkFiles(strPath As String, Optional strFileSpec As String, _
    Optional bIncludeSubfolders As Boolean, Optional lst As ListBox) As Boolean
    Dim SearchString
    
On Error GoTo Err_Handler
    Dim colDirList As New Collection
    Dim varItem As Variant
    Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
            For Each varItem In colDirList
                    If fExistTable("LockVolume" & Left(Right(varItem, 10), 2)) = True Then
                        DoCmd.DeleteObject acTable, "LockVolume" & Left(Right(varItem, 10), 2)
                    End If
                    If fIsFileDIR(MyPath & myFile) = True Then
                        DoCmd.TransferSpreadsheet acLink, 8, "LockVolume" & Left(Right(varItem, 10), 2), strPath & varItem, True, ""
                    End If
            Next
Exit_Handler:
    Exit Function
Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Exit_Handler
End Function
Public Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
    Optional bIncludeSubfolders As Boolean)
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strTemp
        strTemp = Dir
    Loop
    If Nz(bIncludeSubfolders, False) Then
        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
        For Each vFolderName In colFolders
            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

I hope this helps some people out with their issues.