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

Section 1

Max

Option Compare Database
Option Explicit

Const conPathStem As String = "\ExportedAsText\"
Const conPathPages As String = "Pages\"
Const conPathForms As String = "Forms\"
Const conPathMacros As String = "Macros\"
Const conPathModules As String = "Modules\"
Const conPathQueries As String = "Queries\"
Const conPathReports As String = "Reports\"
Const conPathTables As String = "Tables\"
Const conpathTablesLocal As String = "Tables\Local\"
Const conpathTablesLinked As String = "Tables\Linked\"

'Const conPathTablesXLS As String = "Tables\XLS\"
'Const conPathTablesXLSLocal As String = "Tables\XLS\Local\"
'Const conPathTablesXLSLinked As String = "Tables\XLS\Linked\"
'Const conPathTablesXML As String = "Tables\XML\"
'Const conPathTablesXMLLocal As String = "Tables\XML\Local\"
'Const conPathTablesXMLLinked As String = "Tables\XML\Linked\"
Const conTable = 0
Const conQuery = 1
Const conForm = 2
Const conReport = 3
Const conMacro = 4
Const conModule = 5
Const conDAP = 6
Private strObjPath As String
Private strObj As String
Private strDir As String
Private pIntFileNumber As Integer, pIntFileNumber2 As Integer

Private Sub sStart()
    strDir = Application.CurrentProject.Path & conPathStem
    Call sCheckAndCreateSubDirs(strDir)
    Call sExportAllObjects
    Call sImportAllObjects
End Sub



Private Sub sCheckAndCreateSubDirs(strDir As String)
    On Error GoTo errhandler
    Call fCreateFolder(strDir)
    Call fCreateFolder(strDir & conPathPages)
    Call fCreateFolder(strDir & conPathForms)
    Call fCreateFolder(strDir & conPathMacros)
    Call fCreateFolder(strDir & conPathModules)
    Call fCreateFolder(strDir & conPathQueries)
    Call fCreateFolder(strDir & conPathReports)
    'If Not fCreateFolder(strDir & conPathTablesXLS) Then
    Call fCreateFolder(strDir & conPathTables)
    Call fCreateFolder(strDir & conpathTablesLocal)
    Call fCreateFolder(strDir & conpathTablesLinked)
    '  Call fCreateFolder(strDir & conPathTablesXLS)
    '  Call fCreateFolder(strDir & conPathTablesXLSLocal)
    '  Call fCreateFolder(strDir & conPathTablesXLSLinked)
    'End If
    'If Not fCreateFolder(strDir & conPathTablesXML) Then
    '  Call fCreateFolder(strDir & conPathTables)
    '  Call fCreateFolder(strDir & conPathTablesXML)
    '  Call fCreateFolder(strDir & conPathTablesXMLLocal)
    '  Call fCreateFolder(strDir & conPathTablesXMLLinked)
    'End If
exithere:
    Exit Sub
errhandler:
    MsgBox "Unhandled Error in sCheckAndCreateSubDirs(): " & Err.Number &
vbCrLf & Err.Description
    Resume Next
End Sub


Private Function fCreateFolder(sFolder As String) As Boolean
'An error occurs if the specified folder already exists, and that is ok.
    On Error GoTo errhandler
    Dim fs
    fCreateFolder = False
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CreateFolder sFolder
    fCreateFolder = True
exithere:
    Exit Function
errhandler:
    fCreateFolder = False
    Select Case Err.Number
    Case 58  ' Folder already exists
        fCreateFolder = True
        Resume exithere
    Case 76  ' path not found, create intermediate folders
        Resume exithere
    Case 70    ' system not allowing
        Resume exithere
    Case Else
        MsgBox "Cannot Create Folder Error in fCreateFolder():" & Err.Number
& vbCrLf & Err.Description
    End Select
    Resume exithere
End Function