____________________________________

Attribute VB_Name = "ModAutoMDE"
Option Compare Database
Option Explicit
____________________________________

Function GenerateMDEFile(MyPath As String) As String

   Dim NAcc As Access.Application
   Dim strMsg As String

   Set NAcc = CreateObject("Access.Application")

   'The following lines simulate accepting the default
   'name, clicking Make MDE, and clicking Save
   SendKeys MyPath & "{Enter}{Enter}"
   SendKeys "{Enter}"

   NAcc.DoCmd.RunCommand acCmdMakeMDEFile
   strMsg = "Good"
   GenerateMDEFile = strMsg

Exit_GenerateMDEFile:
   Set NAcc = Nothing
Exit Function
Error_GenerateMDEFile:
strMsg = Err.Number & vbCrLf & Err.Description
GenerateMDEFile = strMsg
Resume Exit_GenerateMDEFile
End Function
____________________________________

'?GenerateMDEFile(<Path&DBName>)
Sub sMakeMDEcontroller()
Dim rayDBlist(16) As String
Dim intCurRay As Integer
Dim intMaxRay As Integer
Dim strResult As String
Dim strPath As String

strPath = "C:\Documents and Settings\cyos\My Documents\ECO House\Split\"
rayDBlist(1) = strPath & "ecoAction After Market.mdb"
rayDBlist(2) = strPath & "ecoAction Assembly.mdb"
rayDBlist(3) = strPath & "ecoAction backend.mdb"
rayDBlist(4) = strPath & "ecoAction Crawler Assembly.mdb"
rayDBlist(5) = strPath & "ecoAction Deephole Assembly.mdb"
rayDBlist(6) = strPath & "ecoAction Engineering.mdb"
rayDBlist(7) = strPath & "ecoAction Large Blasthole Assembly.mdb"
rayDBlist(8) = strPath & "ecoAction Mid-Range Blasthole Assm.mdb"
rayDBlist(9) = strPath & "ecoAction Parts Service.mdb"
rayDBlist(10) = strPath & "ecoAction Planning.mdb"
rayDBlist(11) = strPath & "ecoAction Product Support.mdb"
rayDBlist(12) = strPath & "ecoAction Purchasing.mdb"
rayDBlist(13) = strPath & "ecoAction Quality.mdb"
rayDBlist(14) = strPath & "ecoAction Requestor.mdb"
rayDBlist(15) = strPath & "ecoAction Tech Pubs.mdb"
rayDBlist(16) = strPath & "ecoAction Warehouse.mdb"

For intCurRay = 1 To 16
    strResult = GenerateMDEFile(rayDBlist(intCurRay))
    If strResult <> "Good" Then
        Debug.Print rayDBlist(intCurRay) & vbCrLf & strResult
    End If
Next
Erase rayDBlist
MsgBox "MDEs made"
End Sub
____________________________________

Sub sRelinkTables()
Dim ExDb As Database
Dim Tdef As TableDef
Dim strConn As String
Dim strPath As String
Dim strPart As String
Dim rayDBlist(10) As String
Dim intCurRay As Integer
Dim rayTableList(3) As String
Dim intCurTableList As Integer

On Error GoTo Error_sRelinkTables

strPath = "C:\Documents and Settings\cyos\My Documents\ECO House\Split\Revised split\revised MDE\"
'strConn = "MS Access;PWD=simple;DATABASE=C:\Documents and Settings\cyos\My Documents\" _
            & "ECO House\Split\Revised split\revised MDE\ecoAction backend.mde"
strConn = "MS Access;PWD=simple;DATABASE=I:\ECOactions\ecoAction backend.mde"

rayDBlist(1) = strPath & "ecoAction Requestor.mde"
rayDBlist(2) = strPath & "ecoAction Warehouse.mde"
rayDBlist(3) = strPath & "ecoAction Purchasing.mde"
rayDBlist(4) = strPath & "ecoAction Parts Service.mde"
rayDBlist(5) = strPath & "ecoAction After Market.mde"
rayDBlist(6) = strPath & "ecoAction Product Support.mde"
rayDBlist(7) = strPath & "ecoAction Assembly.mde"
rayDBlist(8) = strPath & "ecoAction Planning.mde"
rayDBlist(9) = strPath & "ecoAction Engineering.mde"
rayDBlist(10) = strPath & "ecoAction Quality.mde"

rayTableList(1) = "tblActionRequest"
rayTableList(2) = "tblActionResponse"
rayTableList(3) = "tblLookup"

For intCurRay = 1 To 10
    Set ExDb = OpenDatabase(rayDBlist(intCurRay))
    For intCurTableList = 1 To 3
        Set Tdef = ExDb.TableDefs(rayTableList(intCurTableList))
        Tdef.Connect = strConn
        Tdef.RefreshLink
    Next
Next
MsgBox "Refresh Link Complete"
Exit_sRelinkTables:
Erase rayDBlist
Erase rayTableList
Set Tdef = Nothing
Set ExDb = Nothing
Exit Sub

Error_sRelinkTables:
MsgBox "Error - " & Err.Number & vbCrLf & Err.Description
Resume Exit_sRelinkTables
End Sub
____________________________________

Sub sDistributeNewReports()
Dim ExDb As Database
Dim rayDBlist(10) As String
Dim rayObjectList(4) As String
Dim intCurRay As Integer
Dim intCurObject As Integer
Dim strPath As String

strPath = "C:\Documents and Settings\cyos\My Documents\ECO House\Split\Revised split\"

rayDBlist(1) = strPath & "ecoAction Requestor.mdb"
rayDBlist(2) = strPath & "ecoAction Warehouse.mdb"
rayDBlist(3) = strPath & "ecoAction Purchasing.mdb"
rayDBlist(4) = strPath & "ecoAction Parts Service.mdb"
rayDBlist(5) = strPath & "ecoAction After Market.mdb"
rayDBlist(6) = strPath & "ecoAction Product Support.mdb"
rayDBlist(7) = strPath & "ecoAction Assembly.mdb"
rayDBlist(8) = strPath & "ecoAction Planning.mdb"
rayDBlist(9) = strPath & "ecoAction Engineering.mdb"
rayDBlist(10) = strPath & "ecoAction Quality.mdb"

rayObjectList(1) = "rptActions_ECO"
rayObjectList(2) = "rptElapsedDaysActionDate"
rayObjectList(3) = "rptNoAction"
rayObjectList(4) = "rptOpenRequests"

For intCurRay = 1 To 10
    For intCurObject = 1 To 4
      DoCmd.TransferDatabase acExport, "Microsoft Access", _
        rayDBlist(intCurRay), acReport, rayObjectList(intCurObject), rayObjectList(intCurObject)
      
            
    Next
      DoCmd.TransferDatabase acExport, "Microsoft Access", _
        rayDBlist(intCurRay), acForm, "frmActionResponse", "frmActionResponse"
    
    MsgBox rayDBlist(intCurRay) & "Tranfer Complete"
Next
MsgBox "Reports Replaced"
Set ExDb = Nothing
End Sub
____________________________________

Sub sRelinkTables1()
Dim ExDb As Database
Dim Tdef As TableDef
Dim strConn As String
Dim strPath As String
Dim strPart As String
Dim rayDBlist() As String
Dim intCurRay As Integer
Dim intMaxRay As Integer
Dim rayTableList(3) As String
Dim intCurTableList As Integer
Dim strDbname As String

On Error GoTo Error_sRelinkTables1

'strPath = "C:\Documents and Settings\cyos\My Documents\ECO House\Split\"
strPath = "C:\Documents and Settings\cyos\My Documents\ECO House\Split\revised MDE\"
strConn = "MS Access;PWD=simple;DATABASE=C:\Documents and Settings\cyos\My Documents\" _
            & "ECO House\Split\revised MDE\ecoAction backend.mde"
strConn = "MS Access;PWD=simple;DATABASE=I:\ECOactions\ecoAction backend.mde"

strDbname = Dir(strPath & "*.mde")
'strDbname = Dir(strPath & "*.mdb")
If InStr(1, strDbname, "backend") = 0 Then
    intMaxRay = intMaxRay + 1
    ReDim Preserve rayDBlist(intMaxRay)
    rayDBlist(intMaxRay) = strPath & strDbname
End If
Do
    strDbname = Dir()
    If strDbname = "" Then Exit Do
    If InStr(1, strDbname, "backend") = 0 Then
        intMaxRay = intMaxRay + 1
        ReDim Preserve rayDBlist(intMaxRay)
        rayDBlist(intMaxRay) = strPath & strDbname
    End If
Loop

rayTableList(1) = "tblActionRequest"
rayTableList(2) = "tblActionResponse"
rayTableList(3) = "tblLookup"

For intCurRay = 1 To intMaxRay
    Set ExDb = OpenDatabase(rayDBlist(intCurRay))
    For intCurTableList = 1 To 3
        Set Tdef = ExDb.TableDefs(rayTableList(intCurTableList))
        Tdef.Connect = strConn
        Tdef.RefreshLink
    Next
Next
MsgBox "Refresh Link Complete"
Exit_sRelinkTables1:
Erase rayDBlist
Erase rayTableList
Set Tdef = Nothing
Set ExDb = Nothing
Exit Sub

Error_sRelinkTables1:
MsgBox "Error - " & Err.Number & vbCrLf & Err.Description
Resume Exit_sRelinkTables1
End Sub
____________________________________