openaccess/source/modules/VCS_Table.bas

Option Compare Database

Option Private Module
Option Explicit

Public Sub ExportLinkedTable(ByVal tbl_name As String, ByVal dirpath As String)
    On Error GoTo Err_LinkedTable
    
    Dim tempFilePath As String

    tempFilePath = VCS_File.TempFile()
    
    Dim FSO As Object
    Dim OutFile As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    ' open file for writing with Create=True, Unicode=True (USC-2 Little Endian format)

    Set OutFile = FSO.CreateTextFile(tempFilePath, overwrite:=True, unicode:=True)
    
    OutFile.Write CurrentDb.TableDefs(tbl_name).name
    OutFile.Write vbCrLf
    
    If InStr(1, CurrentDb.TableDefs(tbl_name).connect, "DATABASE=" & CurrentProject.path) Then
        'change to relatave path
        Dim connect() As String
        connect = Split(CurrentDb.TableDefs(tbl_name).connect, CurrentProject.path)
        OutFile.Write connect(0) & "." & connect(1)
    Else
        OutFile.Write CurrentDb.TableDefs(tbl_name).connect
    End If
    
    OutFile.Write vbCrLf
    OutFile.Write CurrentDb.TableDefs(tbl_name).SourceTableName
    OutFile.Write vbCrLf
    
    Dim db As DAO.Database
    Set db = CurrentDb
    Dim td As DAO.TableDef
    Set td = db.TableDefs(tbl_name)
    Dim idx As DAO.Index
    
    For Each idx In td.Indexes
        If idx.Primary Then
            OutFile.Write Right$(idx.Fields, Len(idx.Fields) - 1)
            OutFile.Write vbCrLf
        End If

    Next
    
Err_LinkedTable_Fin:
    On Error Resume Next
    OutFile.Close
    'save files as .odbc
    Dim path As String
    path = dirpath & to_filename(tbl_name) & ".LNKD"
    VCS_File.ConvertUcs2Utf8 tempFilePath, path
    
    Kill tempFilePath
    
    logger "ExportLinkedTable", "DEBUG", "LinkedTable " & tbl_name & " exported to " & path
    
    Exit Sub
    
Err_LinkedTable:
    OutFile.Close
    logger "ExportLinkedTable", "ERROR", "Unable to export " & tbl_name & ": " & err.Description
    Resume Err_LinkedTable_Fin
End Sub

Public Sub ImportLinkedTable(ByVal tblName As String, ByVal obj_path As String)
    Dim db As DAO.Database
    Dim FSO As Object
    Dim InFile As Object
    
    Set db = CurrentDb
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim tempFilePath As String
    tempFilePath = VCS_File.TempFile()
    
    ConvertUtf8Ucs2 obj_path & tblName & ".LNKD", tempFilePath
    
    ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
    Set InFile = FSO.OpenTextFile(tempFilePath, iomode:=ForReading, Create:=False, Format:=TristateTrue)
    
    On Error GoTo err_notable:
    DoCmd.DeleteObject acTable, tblName
    
    GoTo err_notable_fin
    
err_notable:
    err.Clear
    Resume err_notable_fin
    
err_notable_fin:
    On Error GoTo Err_CreateLinkedTable:
    
    Dim td As DAO.TableDef
    Set td = db.CreateTableDef(InFile.readline())
    
    Dim connect As String
    connect = InFile.readline()
    If InStr(1, connect, "DATABASE=.\") Then 'replace relative path with literal path
        connect = Replace(connect, "DATABASE=.\", "DATABASE=" & CurrentProject.path & "\")
    End If
    td.connect = connect
    
    td.SourceTableName = InFile.readline()
    db.TableDefs.Append td
    
    GoTo Err_CreateLinkedTable_Fin
    
Err_CreateLinkedTable:
    logger "ImportLinkedTable", "ERROR", "Unable to import " & tblName & ": " & err.Description
    Resume Err_CreateLinkedTable_Fin
    
Err_CreateLinkedTable_Fin:
    'this will throw errors if a primary key already exists or the table is linked to an access database table
    'will also error out if no pk is present
    On Error GoTo Err_LinkPK_Fin:
    
    Dim Fields As String
    Fields = InFile.readline()
    Dim field As Variant
    Dim sql As String
    sql = "CREATE INDEX __uniqueindex ON " & td.name & " ("
    
    For Each field In Split(Fields, ";+")
        sql = sql & "[" & field & "]" & ","
    Next
    'remove extraneous comma
    sql = Left$(sql, Len(sql) - 1)
    
    sql = sql & ") WITH PRIMARY"
    'CurrentDb.Execute sql
    run_sql sql
    
    
    logger "ImportLinkedTable", "DEBUG", "LinkedTable " & tblName & " improted from " & obj_path & tblName & ".LNKD"

Err_LinkPK_Fin:
    On Error Resume Next
    InFile.Close
    Kill tempFilePath
    
End Sub