UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> TransferSQLDB    
CODE

' TransferSQLDB
' http://www.utteraccess.com/wiki/index.php/FunctionNameHere
' Code courtesy of UtterAccess Wiki
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev  date                          brief descripton
' 1.0  2013-05-30                Reviews the destination DB to see if the query exists, if it doesn't it copies the query from the local DB to the destination DB
'
Public Sub TransferSQLDB(DestinationDB As String)
On Error GoTo errHandler
Dim ForeignDB As Dao.Database
Dim ForeignQueryList() As String
Dim LocalDB As Dao.Database
Dim LocalQueryList() As String
Dim x As Integer, i As Integer, z As Integer
Dim bolFound As Boolean
'Creates Foreign Query List - ForeignQueryList()
Set ForeignDB = DBEngine.Workspaces(0).OpenDatabase(DestinationDB)
x = 0
ReDim ForeignQueryList(ForeignDB.QueryDefs.Count - 1)
With ForeignDB
   For i = 0 To .QueryDefs.Count - 1
       If Left(.QueryDefs(i).Name, 1) <> "~" Then
           ForeignQueryList(x) = .QueryDefs(i).Name
           x = x + 1
       End If
   Next i
End With
'Creates Local Query List - LocalQueryList()
Set LocalDB = DBEngine.Workspaces(0).OpenDatabase(Application.CurrentProject.Path & "\" & Application.CurrentProject.Name)
x = 0
ReDim LocalQueryList(LocalDB.QueryDefs.Count - 1)
With LocalDB
   For i = 0 To .QueryDefs.Count - 1
       If Left(.QueryDefs(i).Name, 1) <> "~" Then
           LocalQueryList(z) = .QueryDefs(i).Name
           z = z + 1
       End If
   Next i
       For z = LBound(LocalQueryList) To UBound(LocalQueryList)
           For i = LBound(ForeignQueryList) To UBound(ForeignQueryList)
               bolFound = False
               If LocalQueryList(z) = ForeignQueryList(i) Then
                   bolFound = True
               End If
           Next i
               If bolFound = False Then
                   MsgBox "Transfering " & LocalQueryList(z)
                   DoCmd.TransferDatabase acExport, "Microsoft Access", DestinationDB, acQuery, LocalQueryList(z), LocalQueryList(z)
               End If
       Next z
End With
ExitHere:
Set ForeignDB = Nothing
Set LocalDB = Nothing
  Exit Sub
errHandler:
  With Err
     MsgBox "Error " & .Number & vbCrLf & .Description, vbOKOnly Or vbCritical
  End With
  Resume ExitHere
End Sub

Creative Commons License
TransferSQLDB by UtterAccess Wiki is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
Editing and revision of the content is freely encouraged; for details, see Expected Usage.

Edit Discussion
Custom Search
Thank you for your support!
This page has been accessed 2,106 times.  This page was last modified 15:02, 30 May 2013 by dspadic.   Disclaimers