strFilenameBK = AanmaakDb(Me.Directorie,Currentdb.Name)
Call DeleteTableIfExist(strTabel)
Call ImportTabel(strDatabaseName, strTabel, strTabel)
Call ExportTabel(strFilenameBK, strTabel, strTabel)
Call DeleteTableIfExist(strTabel)
Call LinkTabelAccess(strDatabaseName, strTabel)
Private Function LinkTabelAccess(strDb As String, strTbl As String) As Boolean
Dim tdf As TableDef
On Error GoTo LinkTabelAccessErr
Set tdf = CurrentDb.CreateTableDef(strTbl)
tdf.Connect = ";DATABASE=" & strDb
tdf.SourceTableName = strTbl
CurrentDb.TableDefs.Append tdf
CurrentDb.TableDefs.Refresh
LinkTabelAccess = True
LinkTabelAccessErr:
If Err.Number <> 0 Then
Err.Clear
End If
End Function
Private Function ImportTabel(strDb As String, strTbl As String, strTblBk As String) As Boolean
On Error GoTo ErrBk
DoCmd.TransferDatabase acImport, "Microsoft Access", strDb, acTable, strTbl, strTblBk, False
ImportTabel = True
ErrBk:
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical + vbOKOnly, "Foutnummer: " & Err.Number
Err.Clear
End If
End Function
Private Function ExportTabel(strBackupDb As String, strTbl As String, strTblBk As String) As Boolean
On Error GoTo ErrBk
DoCmd.TransferDatabase acExport, "Microsoft Access", strFilenameBK, acTable, strTbl, strTblBk, False
ExportTabel = True
ErrBk:
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical + vbOKOnly, "Foutnummer: " & Err.Number
Err.Clear
End If
End Function
Private Function AanmaakDb(strDirBk As String, strDbname As String) As String
Dim objAccess As Object
Dim strDbTemp As String
On Error GoTo AanmaakDbErr
strDbTemp = "bfpl_dat_" & Day(Date) & Format(Date, "mmm") & Right(Year(Date), 2) & ".accdb"
strDbTemp = strDirBk & strDbTemp
If FileExist(strDbTemp) Then Call FileDelete(strDbTemp)
Set objAccess = CreateObject("Access.Application")
Call objAccess.NewCurrentDatabase(strDbTemp)
objAccess.Quit
If FileExist(strDbTemp) = True Then AanmaakDb = strDbTemp
AanmaakDbErr:
If Err.Number <> 0 Then
Err.Clear
End If
End Function
Public Function DeleteTableIfExist(strTableNameExist As String) As Boolean
Dim rs As Recordset
On Error GoTo TableNotExist
CurrentDb.TableDefs.Delete strTableNameExist
DeleteTableIfExist = True
TableNotExist:
If Err.Number > 0 Then
Err.Clear
Exit Function
End If
End Function