Pivot table connection to access database - update data source with vb

[djredden73]

I have 2 existing Pivot Tables that connect to 2 separate tables from the same Access Database. (all on Sheet2
On Sheet3 in cell D5 I give the user the ability to type in the source of where they placed the source Access Database.

I tried to utilize VB to look at Sheet3.Range("D5") to update the source; but it basically keeps the same source I originally created. I have a feeling it is due to the Connections("STARS_DASHBOARD7") in red font below. But I don't know how else to accomplish this. Please help!

 ActiveSheet.PivotTables("PivotTable1").PivotSelect "Contract[All]", xlLabelOnly _
        , True
    Range("B6").Select
    With ActiveWorkbook.Connections("STARS_DASHBOARD7").OLEDBConnection
        .BackgroundQuery = True
        .CommandText = Array("Identified_Data")
        .CommandType = xlCmdTable
        .Connection = Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & Sheet3.Range("D5") & "" _
        , _
        ";Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Data" _
        , _
        "base Password="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global " _
        , _
        "Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;J" _
        , _
        "et OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support" _
        , " Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False")
        .RefreshOnFileOpen = False
        .SavePassword = False
        .SourceConnectionFile = ""
        .ServerCredentialsMethod = xlCredentialsMethodIntegrated
        .AlwaysUseConnectionFile = False
    End With
    With ActiveWorkbook.Connections("STARS_DASHBOARD7")
        .Name = "STARS_DASHBOARD7"
        .Description = ""
    End With
    ActiveWorkbook.Connections("STARS_DASHBOARD7").Refresh