How to create backup for my table in another DB with VBA

POM

Registered User.
Local time
Tomorrow, 01:33
Joined
Dec 27, 2013
Messages
39
Hi every one who can help me thank for all
 
Your SQL Statement against a table will need to be changed, as will the path to the external access db (accdb)
If I didn't delete more than the comments and custom logging code
This should delete an existing table in a remote database
Then re-write the table based on a query from the currentDB

There are many variations you can customize.
This is used when a outside group wants to get current information from a fixed DB with a fixed table. The code takes a sql query - then deletes the old table, verifies the deletion, and recreates the table.
It is a basic of Publishing -- > Subscribing


Code:
Private Sub cmd_Update_GIS_DB_Click()
      Dim mySQL As String
      Dim DBPath As String
      Dim result
      Dim TblName As String
      Dim RecordCount As Long
      Dim RecordCountMessage
10    On Error GoTo PROC_Exit
20    DoCmd.Hourglass True
35        DBPath = "X:\Regulatory_GIS.accdb"   ' published path
 
40       TblName = "Regulatory_GIS"
mySQL = "SELECT View_GIS_Union.ObjectID, View_GIS_Union.St, View_GIS_Union.Well_Name, View_GIS_Union.SHLBHL, View_GIS_Union.ReqFin, " & _
"CDbl([View_GIS_Union].[Latitude_GIS]) AS [LatitudeGIS] , CDbl(View_GIS_Union.[Longitude_GIS]) AS LongitudeGIS, CDbl(View_GIS_Union.[Latitude-SHLBHL]) AS LatitudeSHLBHL, CDbl(View_GIS_Union.[Longitude-SHLBHL]) AS LongitudeSHLBHL, " & _
"  View_GIS_Union.Well_County, View_GIS_Union.FIPS_State, View_GIS_Union.FIPS_County, View_GIS_Union.[Well Status] as Well_Status, Now() AS Publish_Date,  View_GIS_Union.API_Number, View_GIS_Union.NodeID, View_GIS_Union.Formation "
mySQL = mySQL & " INTO Regulatory_GIS IN mySQL = mySQL & " ORDER BY View_GIS_Union.St, View_GIS_Union.Well_Name, View_GIS_Union.SHLBHL, View_GIS_Union.ReqFin;"
Debug.Print mySQL
 
80        MsgBox "Before Delete there were " & CountRecords(DBPath, TblName) & " Records with timestamp date of " & OldestDate(DBPath, TblName), vbOKOnly + vbInformation, "Step 1 of 3  Update GIS database located at: " & DBPath
90                            Call LogUsage_GIS("Report", "Before Update recordcount: " & CountRecords(DBPath, TblName), "Old Timestamp: " & OldestDate(DBPath, TblName))
100      result = DeleteTableFromBackEnd(DBPath, TblName)
            ' add linked table to populate - this is used to report what is in the GIS database
            DoEvents
 
110       MsgBox "Old GIS data Table deleted status is : " & result & "   Verify zero records:  There are " & CountRecords(DBPath, TblName) & " Records ", vbOKOnly + vbInformation, "Step 2 of 3  Update GIS database located at: " & DBPath
120           Call LogUsage_GIS("Report", "Zero Confirms Deleted Table: " & CountRecords(DBPath, TblName), "Deleted Table Status: " & result)
            ' The Next Line of code does populate the remote database. But, the database in Design mode can not be saved Message:
130      CurrentDb.Execute mySQL
             'Debug.Print " Err.description " & Err.Description ' no errors - but "You do not have exclusive access to the database at this time" if switch to design mode.
140       MsgBox "GIS Data updated status is : " & result & "   There are " & CountRecords(DBPath, TblName) & " Records     New record Timestamp is: " & OldestDate(DBPath, TblName), vbOKOnly + vbInformation, "Step 3 of 3  Update GIS database located at: " & DBPath
150           ' Call LogUsage_GIS("Report", "After Update recordcount: " & CountRecords(DBPath, TblName), "New Timestamp: " & OldestDate(DBPath, TblName)) ' custom logging function commented out
160      DoCmd.Hourglass False
PROC_Exit:
170       On Error Resume Next
180         DoCmd.Hourglass False
190       Exit Sub
PROC_Error:
200       Select Case Err.Number
              Case 3010
210                 MsgBox "The table was not delete before refreshing it, possibly due to network delay please try again", "Update Remote DB"
220           Case Else
230                 MsgBox " please make a note of this unknown error: " & Err.Description, "Unknown Error"
240               Resume PROC_Exit
250       End Select
End Sub
 
wow my friend thank you very very much
 
Last edited:
Thank you Rx for help me I wish you beast
 

Users who are viewing this thread

Back
Top Bottom