[AccessD] Add-In Express 2009 for MS Office and .NET

Section 3 - Import

That's the lot now.  No form or user interface. I hope it works ok, seem ok
on my test system but caveat emptor as  always.

I will try to get the complete code in the next email, size will determine
if it gets through.

Change the sStart to either export or import. As shown it does both which
should get rid of bloat in one foul swoop.

But, who knows the secrets of the Black Magic Box?

Max

Private Sub sStart()
    Call sCheckAndCreateSubDirs(strDir)
    Call sExportAllObjects
    Call sImportAllObjects
    MsgBox "Done"
End Sub


Private Sub sImportAllObjects()
    On Error GoTo errhandler
    Dim strTemp As String, strFile As String, strPath As String, sql As
String, strIn As String
    Dim dbs As DAO.Database, qdf As DAO.QueryDef
    Set dbs = CurrentDb
    strDir = Application.CurrentProject.Path & conPathStem
    '    '  Forms
    strPath = strDir & "Forms\"
    strTemp = Dir(strPath)
    Do While strTemp <> ""
        strFile = Left(strTemp, InStrRev(strTemp, ".txt") - 1)
        ' Application.LoadFromText acForm, strFile, strPath & strTemp
        strTemp = Dir()
    Loop
    '    '  Macros
    strPath = strDir & "Macros\"
    strTemp = Dir(strPath)
    Do While strTemp <> ""
        strFile = Left(strTemp, InStrRev(strTemp, ".txt") - 1)
        'Application.LoadFromText acMacro, strFile, strPath & strTemp
        strTemp = Dir()
    Loop
    '    '  Modules
    strPath = strDir & "Modules\"
    strTemp = Dir(strPath)
    Do While strTemp <> ""
        strFile = Left(strTemp, InStrRev(strTemp, ".txt") - 1)
        If strFile <> "modEatBloat" Then    'don't overright self
            'Application.LoadFromText acModule, strFile, strPath & strTemp
        End If
        strTemp = Dir()
    Loop

    '    '  Queries
    strPath = strDir & "Queries\"
    strTemp = Dir(strPath)
    Do While strTemp <> ""
        strFile = Left(strTemp, InStrRev(strTemp, ".txt") - 1)
        pIntFileNumber2 = FreeFile: sql = ""
        Open strPath & strTemp For Input As pIntFileNumber2
        Do While Not EOF(pIntFileNumber2)
            Line Input #pIntFileNumber2, strIn: sql = sql & strIn & vbCrLf
        Loop
        Close pIntFileNumber2
        On Error Resume Next  ' if it exists then delete first, then
recreate it
        DoCmd.DeleteObject acQuery, strFile
        On Error GoTo errhandler
        Set qdf = dbs.CreateQueryDef(strFile, sql)
        strTemp = Dir()
    Loop

    '  Reports
    strPath = strDir & "Reports\"
    strTemp = Dir(strPath)
    Do While strTemp <> ""
        strFile = Left(strTemp, InStrRev(strTemp, ".txt") - 1)
        Application.LoadFromText acReport, strFile, strPath & strTemp
        strTemp = Dir()
    Loop

    '  Tables
    strPath = strDir & "Tables\Local\"
    strTemp = Dir(strPath)
    Do While strTemp <> ""
        Select Case Right(strTemp, 4)
        Case ".xls"
            strFile = Left(strTemp, InStrRev(strTemp, ".xls") - 1)
            On Error Resume Next
            sql = "Drop Table " & strFile
            DoCmd.TransferSpreadsheet acImport, , strFile, strPath &
strTemp, True
        Case ".xml"
            '            If Not InStr(strObj, "Schema") > 0 Then
            '                Application.ImportXML strObjPath,
acStructureAndData
            '            End If
        End Select
        strTemp = Dir()
    Loop

exithere:
    Set dbs = Nothing: Set qdf = Nothing
    Exit Sub
errhandler:
    Select Case Err.Number
    Case Else
        MsgBox "Unhandled Error in sImportAllObjects(): " & Err.Number &
vbCrLf & Err.Description
    End Select
    Resume Next
End Sub