Results 1 to 5 of 5
  1. #1
    5 Star Lounger
    Join Date
    Aug 2004
    Location
    Connecticut, USA
    Posts
    816
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Alter second Access file using macro (2000 / SR1)

    I have a VBA routine that changes the SourceTableName dependent of a table dependent upon its current SourceTableName. What I would like to do is be able to run the macro against an entire directory, or at the very least against user chosen files.

    I've pieced together code from the Lounge, but am not savvy enough to alter the code to my needs.

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Alter second Access file using macro (2000 / SR1)

    The following is air code, I haven't actually tested it:
    <code>
    Sub Test()
    ' Path must end in a backslash
    ReplaceSourceTableName "Catabases", "tblOld", "tblNew"
    End Sub

    Sub ReplaceSourceTableName(strPath As String, strOld As String, strNew As String)
    Dim strFile As String
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef

    On Error GoTo ErrHandler

    strFile = Dir(strPath & "*.mdb")
    Do While Not strFile = ""
    Set dbs = OpenDatabase(strPath & strFile)
    For Each tdf In dbs.TableDefs
    If Not tdf.Connect = "" Then
    tdf.SourceTableName = Replace(tdf.SourceTableName, strOld, strNew)
    tdf.RefreshLink
    End If
    Next tdf
    dbs.Close
    strFile = Dir
    Loop

    ExitHandler:
    On Error Resume Next
    Set tdf = Nothing
    dbs.Close
    Set dbs = Nothing
    Exit Sub

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
    End Sub
    </code>
    The idea is to replace the string values in Sub Test. The code will loop through all databases in the specified folder and through all tables in each database.

  3. #3
    5 Star Lounger
    Join Date
    Aug 2004
    Location
    Connecticut, USA
    Posts
    816
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Alter second Access file using macro (2000 / SR1)

    Thanks for the code Hans. I was able to add the code I had to what you supplied. I could not use your code in its entirety because the SourceTableName property cannot be set once the object is part of a collection (slight rewording of error message).

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Alter second Access file using macro (2000 / SR1)

    Hmm - according to the Microsoft documentation,
    <hr>This property setting is read-only for a base table and read/write for a linked table or an object not appended to a collection.<hr>
    Source: SourceTableName Property, italics mine.

  5. #5
    5 Star Lounger
    Join Date
    Aug 2004
    Location
    Connecticut, USA
    Posts
    816
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Alter second Access file using macro (2000 / SR1)

    I failed to mention that the tables were linked. The table are accessed using an ODBC driver.
    This is my final code (my addition of course is the blue stuff):

    <pre>
    Sub Test()
    ' Path must end in a backslash
    ReplaceSourceTableName Environ("Userprofile") & "desktopconvert", "64", ""
    'ReplaceSourceTableName "Catabases", "64", ""
    End Sub

    Sub ReplaceSourceTableName(strPath As String, strOld As String, strNew As String)
    Dim strFile As String, strOldTable As String, strNewTable As String
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim tdfNew As DAO.TableDef
    Dim strOldName As String, tblDelete As String
    Dim i As Long

    'On Error GoTo ErrHandler

    strFile = Dir(strPath & "*.mdb")
    'MsgBox strFile
    Do While Not strFile = ""
    Me.lblStatus.Caption = "Updating: " & Left(strFile, Len(strFile) - 4)





    Set dbs = OpenDatabase(strPath & strFile)
    For Each tdf In dbs.TableDefs
    If Not tdf.Connect = "" Then
    If Left(tdf.Connect, 4) = "ODBC" Then
    If InStr(tdf.SourceTableName, "64") > 0 Then

    tblDelete = tdf.Name
    <font color=448800>
    'Set tdfNew = dbs.CreateTableDef(tdf.Name)
    'tdfNew.Connect = dbs.TableDefs(tdf.Name).Connect
    </font color=448800>

    <font color=blue>

    Set tdfNew = dbs.CreateTableDef(tdf.Name)
    tdfNew.Connect = dbs.TableDefs(tdf.Name).Connect
    strOldName = tdf.SourceTableName

    tdfNew.SourceTableName = Replace(strOldName, "64", "")

    If tdf.SourceTableName = "BPCSUSRF64.ESPAL50" Then


    tdfNew.SourceTableName = "BPCSF.ESPAL50"
    End If
    dbs.Execute "DROP TABLE " & tdf.Name
    dbs.TableDefs.Append tdfNew
    </font color=blue>
    End If
    End If
    End If
    Next tdf
    dbs.Close
    strFile = Dir
    Loop

    ExitHandler:
    On Error Resume Next
    Set tdf = Nothing
    dbs.Close
    Set dbs = Nothing
    Me.lblStatus.Caption = "Conversion process is complete"
    Exit Sub

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
    End Sub
    </pre>


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •