Code amendment needed for a workbook sharing macro (vba)

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
Code:
Option Explicit
Dim objFSO, objFile As Object
Dim objConnection, objRecordset As Object
Dim LastLocalChange, LastDbUpdate As Date
Dim DbFile, ConnString As String

Sub SyncToDatabase()
    DbFile = Sheet1.Range("M5").Value 'Customer Database Location
    LastLocalChange = Sheet1.Range("B12").Value
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    On Error GoTo FileMissing
    Set objFile = objFSO.GetFile(DbFile)
    If objFile.DateLastModified < LastLocalChange Then 'Local Change was made, update Database
        Kill (DbFile) 'Delete the current database version
        ThisWorkbook.Sheets("CustDb").Copy
        ActiveWorkbook.SaveAs DbFile, FileFormat:=51
        ActiveWorkbook.Close False
    End If
    Exit Sub
FileMissing:
    MsgBox "Please browse for the database file", vbInformation, ""
    BrowseForFile
End Sub

Sub SyncFromDatabase()
    LastLocalChange = Sheet1.Range("B12").Value
    DbFile = Sheet1.Range("M5").Value 'Customer Database Location
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    On Error GoTo FileMissing
    Set objFile = objFSO.GetFile(DbFile)
    If objFile.DateLastModified > LastLocalChange Then 'Database Change was made, update Local Database
        'Check Last Database Update
        Sheet2.Range("A2:G9999").ClearContents 'Clear existing data
        On Error Resume Next
        Set objConnection = CreateObject("ADODB.Connection")
        Set objRecordset = CreateObject("ADODB.Recordset")
        objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
        Sheet1.Range("M5").Value & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=0"";"
        objRecordset.Open "Select * FROM [CustDb$]", objConnection
        
        Sheet2.Range("A2").CopyFromRecordset objRecordset
        
        objRecordset.Close
        objConnection.Close
        On Error GoTo 0
    End If

    Exit Sub
FileMissing:
    MsgBox "Please browse for the database file", vbInformation, ""
    BrowseForFile
End Sub

This code is currently used to sync data to and from the database workbook (CustData). The CustData has just one sheet "CustDb" and if the local data is fresher than the data in the database, we update the database and vice versa.

I do not entirely understand what the various lines are doing - making it very difficult for me to do any vital amendments. I believe that if I able to explain exactly what I want to do or achieve, some great mind here could get it fixed ASAP for me.

So instead of having just one sheet in the database, I will be having multiple sheets. Say "CustDb1", "CustDb2" and so on. And the same sheets will be available in the local file as well.

My primary goal here is to be able to sync data to and from the corresponding sheets between the two workbooks. That is, if I am interacting with the "CustDb1" sheet from the local file (workbook), then the data should be synced to and/or from the "CustDb1" sheet in the database.

The database file is a macro-free workbook. I hope someone could fix this for me. Thanks in advance.
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
It looks like mininimally you'd have to add a new sheet, update the code to work with two sheets, and (probably) take care of the "bookkeeping" that happens with whatever is in Cells M5 and B12 (database location and last change).

To update the code to work with two sheets you could just duplicate the entire code and use it the same way with another sheet. Or you could adapt the code as is to work with two different sheets depending on which one needs to be updated. Or just go ahead and update both whenever either one or both changes.

Or as a third and absolutely simplest option, just copy the workbook entirely so you have one workbook for the first "database" and another for the second "database" (but you'd still likely have to make sure they have different names for the "database files" that they are creating.
 
Upvote 0
@xenou ,
Your suggestions look great to me. I am ever ready for any option that works.

So I would be very glad if you could offer me the simplest like you pointed out in option 3 or 2
 
Upvote 0
Option 3 is the simplest. Copy the workbook and start a new database. You would only have to give it a new name to save as, since now you have two database files, not one.
 
Upvote 0
Option 3 is the simplest. Copy the workbook and start a new database. You would only have to give it a new name to save as, since now you have two database files, not one.
Can you show me the codes to do that?

It seems I am confused about what you want me to do.
 
Upvote 0
This line saves your "database file"
VBA Code:
ThisWorkbook.Sheets("CustDb").Copy
        ActiveWorkbook.SaveAs DbFile, FileFormat:=51

If you are saving two files and they have the same name they will be overwriting each other and that's a problem. So they need to have different names, meaning different SaveAs names (the names you give the files when you save them).
 
Upvote 0
Oh okay. I am getting the picture now - but it seems the option 3, though very simple, could get me into bigger troubles in the future.
And as such, I think the first option you provided would be the safest path for me to take. In this case, with the same database file, I can manipulate multiple sheets like you explained in your first post.
 
Upvote 0
How many sheets are in your database currently? What in general is on the first sheet and specifically in Cells B12 and M5?
 
Upvote 0
The link to the files:

1. The workbook

2. The database

These are the original workbooks I found on the Internet.
 
Upvote 0
As a rule I do not download files at work. I will probably have a chance to take a look this weekend. Are you able to answer the previous question without sharing files?
 
Upvote 0

Forum statistics

Threads
1,223,892
Messages
6,175,236
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top