i have created a function that will
"Refresh" your Excel link Table.
actually you cannot really "refresh"
the link without deleting the
Link table first and then
creating new Link table.
the function RefreshExcelLink() can
be called within AutoExec macro
or on Timer Event of a Form.
besure that when you call this function,
the Link Excel file is closed and
not in used.
to call:
RefreshExcelLink("nameOfLinkExcelFile")
paste the code in a Standard Module.
'******
AGAIN backup your db first to test this.
if you are confident that it will do
the work, do as you pleased.
Code:
Public Function RefreshExcelLink(ByVal strLink As String)
'**************************************************
'*
'* strLink is the name of Excel Link table
'* in Navigation Pane
'*
'**************************************************
Dim td As TableDef
Dim db As DAO.Database
Dim strFile As String
Dim strConnect As String
Dim strSource As String
Dim strPath As String
Dim strExt As String
On Error Resume Next
Set db = CurrentDb
Set td = db.TableDefs(strLink)
'* get original sourcetable and connection string
strSource = td.SourceTableName
strConnect = td.Connect
'* close the link file
Set td = Nothing
'* remove portion of connection string
strPath = Mid(strConnect, InStrRev(strConnect, "DATABASE="))
strConnect = Left(strConnect, Len(strConnect) - Len(strPath))
'* extract the path of file to link
strPath = Replace(strPath, "DATABASE=", "")
'* extract the extension portion
strExt = Mid(strPath, InStrRev(strPath, ".") + 1)
'* extract the path to link (final)
strPath = Left(strPath, InStrRev(strPath, "\"))
'* get the last modified file
strFile = LastModifiedFile(strPath, strExt)
'* delete old link file
db.TableDefs.Delete (strLink)
'* create new link file
Set td = db.CreateTableDef(strLink)
With td
.Connect = strConnect & "DATABASE=" & strFile
.SourceTableName = strSource
End With
db.TableDefs.Append td
Set td = Nothing
db.TableDefs.Refresh
Set db = Nothing
Application.RefreshDatabaseWindow
End Function
Public Function LastModifiedFile(ByVal strPath As String, Optional ByVal strExt As String = "") As Variant
Dim oLastFile As Object
Dim oFile As Object
Dim oFS As Object
On Error GoTo ExitFunction
strPath = Replace(strPath & "\", "\\", "\")
strExt = LCase(strExt)
Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oFile In oFS.GetFolder(strPath).Files
If strExt = "" Or strExt = LCase(oFS.GetExtensionName(oFile.Name)) Then
If oLastFile Is Nothing Then
Set oLastFile = oFile
Else
If oLastFile.DateLastModified < oFile.DateLastModified Then
Set oLastFile = oFile
End If
End If
End If
Next
LastModifiedFile = strPath & oLastFile.Name
ExitFunction:
Set oLastFile = Nothing
Set oFile = Nothing
Set oFS = Nothing
End Function
here is another code, that
replace link excel file with
the latest, without deleting
the Tabledef.
Code:
Public Function RefreshExcelLink2(ByVal strLink As String)
'**************************************************
'*
'* strLink is the name of Excel Link table
'* in Navigation Pane
'*
'**************************************************
Dim TD As TableDef
Dim DB As DAO.Database
Dim strFile As String
Dim strConnect As String
Dim strSource As String
Dim strPath As String
Dim strExt As String
On Error Resume Next
Set DB = CurrentDb
Set TD = DB.TableDefs(strLink)
'* get original sourcetable and connection string
strSource = TD.SourceTableName
strConnect = TD.Connect
'* remove portion of connection string
strPath = Mid(strConnect, InStrRev(strConnect, "DATABASE="))
strConnect = Left(strConnect, Len(strConnect) - Len(strPath))
'* extract the path of file to link
strPath = Replace(strPath, "DATABASE=", "")
'* extract the extension portion
strExt = Mid(strPath, InStrRev(strPath, ".") + 1)
'* extract the path to link (final)
strPath = Left(strPath, InStrRev(strPath, "\"))
'* get the last modified file
strFile = LastModifiedFile(strPath, strExt)
'* create the new link file
With TD
.Connect = strConnect & "DATABASE=" & strFile
'.SourceTableName = strSource
.RefreshLink
End With
Set TD = Nothing
DB.TableDefs.Refresh
Set DB = Nothing
Application.RefreshDatabaseWindow
End Function
Public Function LastModifiedFile(ByVal strPath As String, Optional ByVal strExt As String = "") As Variant
Dim oLastFile As Object
Dim oFile As Object
Dim oFS As Object
On Error GoTo ExitFunction
strPath = Replace(strPath & "\", "\\", "\")
strExt = LCase(strExt)
Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oFile In oFS.GetFolder(strPath).Files
If strExt = "" Or strExt = LCase(oFS.GetExtensionName(oFile.Name)) Then
If oLastFile Is Nothing Then
Set oLastFile = oFile
Else
If oLastFile.DateLastModified < oFile.DateLastModified Then
Set oLastFile = oFile
End If
End If
End If
Next
LastModifiedFile = strPath & oLastFile.Name
ExitFunction:
Set oLastFile = Nothing
Set oFile = Nothing
Set oFS = Nothing
End Function
