update data to match worksheets instead of deleting entire workbook

[kelly mort]

Cross-posted at:

Update data to match worksheets instead of deleting entire workbook [SOLVED]

I found this code somewhere on a YouTube link (I cannot recall the exact link ATM). I love the code and have tried it in various ways and it is cool, I want to modify it but I can't seem to figure out how to get that done. As you will see from the attached workbooks, the original files I...

www.excelforum.com

Reason:
It has been up there for a few days now but no reply apart from my own replies.


Link to work books:

Dropbox

www.dropbox.com

Dropbox

www.dropbox.com

The code below is how I managed to fix my problem - If there is still a better way to get the job done, I am also open to better ways.

Option Explicit
Dim objFSO, objFile As Object
Dim objConnection, objRecordset As Object
Dim LastLocalChange, LastDbUpdate As Date
Dim DbFile, ConnString As String
Dim db As Workbook, rng As Range, lr&

Sub SyncToDatabase()
    With Application
        .ScreenUpdating = False
        DbFile = Sheet1.Range("M5").Value
        LastLocalChange = Sheet1.Range("B12").Value
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        On Error GoTo FileMissing
        Set objFile = objFSO.GetFile(DbFile)
        If objFile.DateLastModified < LastLocalChange Then
            Set db = .Workbooks.Open(DbFile)
            With ThisWorkbook.Sheets("CustDb")
                If .Cells(Rows.Count, 1).End(xlUp).Row > db.Sheets("CustDb").Cells(Rows.Count, 1).End(xlUp).Row Then
                    lr = .Cells(Rows.Count, 1).End(xlUp).Row
                Else
                    lr = db.Sheets("CustDb").Cells(Rows.Count, 1).End(xlUp).Row
                End If
                If lr < 2 Then lr = 2
                Set rng = .Range("A2:G" & lr)
                db.Sheets("CustDb").Range("A2").Resize(rng.Rows.Count, rng.Columns.Count) = rng.Value
            End With
            db.Close True
        End If
        .ScreenUpdating = True
    End With
    Exit Sub
FileMissing:
    MsgBox "Please browse for the database file"
    BrowseForFile
End Sub

Then the code below here is where I need the next help with.

Sub SyncFromDatabase()
    LastLocalChange = Sheet1.Range("B12").Value
    DbFile = Sheet1.Range("M5").Value
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    On Error GoTo FileMissing
    Application.ScreenUpdating = False
    Set objFile = objFSO.GetFile(DbFile)
    If objFile.DateLastModified > LastLocalChange Then
        Sheet2.Range("A2:G9999").ClearContents
        On Error Resume Next
        Set objConnection = CreateObject("ADODB.Connection")
        Set objRecordset = CreateObject("ADODB.Recordset")
        objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
        DbFile & ";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
    End If
    Application.ScreenUpdating = True
    Exit Sub
FileMissing:
    MsgBox "Please browse for the database file"
    BrowseForFile
End Sub

Instead of hardcoding the CustDb

 [CustDb$] [/ccode]
[IMG]http://icons.iconarchive.com/icons/double-j-design/ravenna-3d/24/File-Copy-icon.png[/IMG]
[code] objRecordset.Open "Select * FROM [CustDb$]", objConnection

When I use a variable say Set sh = Sheets("CustDb"), how do I use the sh in the line above?

 

[kelly mort]

This is how I managed to get it working:

objRecordset.Open "Select * FROM [" & sh & "$]", objConnection

Thanks to you all.