Oleh-oleh Kopdar

Sekadar oleh-oleh hasil sharing pada KOPDAR ACCESS 2013 @ Krekot, Jakarta Pusat.

Script untuk melink table secara otomatis (taruh di sebuah module umum):

'Written by John Hawkins 20/9/99 www.fabalou.com
Public Function RelinkTables(ByVal newDataFile) As Boolean
    Dim NewPathname As String
    Dim dbs As Database
    Dim Tdf As TableDef
    Dim Tdfs As TableDefs
    Set dbs = CurrentDb
    Set Tdfs = dbs.TableDefs
    '
    NewPathname = newDataFile
    If IsFileExists(NewPathname) Then
        dbPassword = ""
        'Loop through the tables collection
        On Error Resume Next    'just to ignore the error message, relinking process still be done
        For Each Tdf In Tdfs
            If ((Tdf.Attributes And dbSystemObject) = 0) And (Tdf.Connect <> vbNullString) And Not (Tdf.Name Like "~*") Then
            'If Tdf.SourceTableName <> "" Then 'If the table source is other than a base table
                'Tdf.Connect = ";DATABASE=" & NewPathname & ";Pwd=" & dbPassword 'Set the new source
                Tdf.Connect = ";DATABASE=" & NewPathname 'Set the new source
                Tdf.RefreshLink 'Refresh the link
                RelinkTables = True 'paling tidak pernah lewat sini
            End If
        Next 'Goto next table
        Set Tdfs = Nothing
        Set dbs = Nothing
        '
        If IsMDE() Then
            SecuringTables
        End If
    End If
End Function

Function untuk memeriksa keberadaan file:

'taken from: http://www.tek-tips.com/faqs.cfm?fid=4116 (by Bowers74)
'6 Jan 2010

Function IsFileExists(pFilePath) As Boolean     'modified by Haer
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    IsFileExists = fso.FileExists(pFilePath)
    Set fso = Nothing
End Function

Function untuk test MDE:

Function IsMDE()
    IsMDE = Right(Application.CurrentProject.Name, 1) = "E"
End Function

Procedure untuk menyembunyikan table:

Sub SecuringTables(Optional nHide As Boolean = True)
    Dim db As Database
    Set db = CurrentDb
    On Error Resume Next
    For i = 0 To db.TableDefs.Count - 1
        If Left(db.TableDefs(i).Name, 4) = "mSys" Or _
            Left(db.TableDefs(i).Name, 1) = "~" Or _
            Left(db.TableDefs(i).Name, 4) = "Usys" Then
            'Not a Table
        Else
            db.TableDefs(i).Attributes = IIf(nHide, 1, 0) ' 1=Hide, 0=Normal
        End If
    Next
    Set db = Nothing
End Sub

Cara Pemakaian:

If Not RelinkTables(vPath & tDatabaseFile) Then
   MsgBox "File database tidak bisa dibuka!"
End If