Este fórum está sendo desativado

[RogerioMello]

Estou aprendendo VBA por conta própria através da leitura do livro do Bill Jelen. Na parte de conexão com tabelas externas através da tabela dinâmica não consigo rodar o código. Tentei algumas alterações, busquei algumas coisas na internet porém não tive sucesso, gostaria da ajuda de alguém para que o código funcione.

O problema no código encontra-se na parte do CreateModelConnection

Sub Tabela_Dinamica()

Dim WBT As Workbook
Dim WC As WorkbookConnection
Dim MO As Model
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim WS As Worksheet
Dim CFRevenue As CubeField
Dim CFCustomer As CubeField

Set WBT = ActiveWorkbook
Set WS = WBT.Worksheets("Resultado")

TableName = "Vendas"
WBT.Connections.Add Name:="LinkedTable_" & TableName, Description:="TabelaPrincipal", _
ConnectionString:="Worksheet;" & WBT.FullName, CommandText:=WBT.Name & "!" & TableName, _
LcMDTYPE:=7, CreateModelConnection:=True, ImportRelationship:=False

TableName = "Setor"
WBT.Connections.Add Name:="LinkedTable_" & TableName, Description:="TabelaPrincipal", _
ConnectionString:="Worksheet;" & WBT.FullName, CommandText:=WBT.Name & "!" & TableName, _
LcMDTYPE:=7, CreateModelConnection:=True, ImportRelationship:=False

Set MO = ActiveWorkbook.Model
MO.ModelRelationships.Add ForeignKeyColumn:=MO.ModelTables("Vendas").ModelTableColumns("Customer"), _
PrimaryKeyColumn:=MO.ModelTables("Setor").ModelTableColumns("Customer")

For Each PT In WS.PivotTables
PT.TableRange2.Clear
Next PT

Set PTCache = WBT.PivotCaches.Create(xlExternal, WBT.Connections("ThisWorkbookDataModel"), xlPivotTableVersion15)
Set PT = PTCache.CreatePivotTable(WS.Cells(1, 1), "PivotTable1")

With PT.CubeFields("[Setor].[Sector]")
.Orientation = xlRowField
.Position = 1
End With

Set CFRevenue = PT.CubeFields.GetMeasure(AttributeHierarchy:="[Vendas].[Revenue]", Function:=xlSum, _
Caption:="Soma da Revenda")
PT.AddDataField Field:=CFRevenue, Caption:="Total de Revenda"
PT.PivotFields("Total de Revenda").NumberFormat = "$#,##0,K"

Set CFCustomer = PT.CubeFields.GetMeasure(AttributeHierarchy:="[Vendas].[Customer]", Function:=xlDistinctCount, _
Caption:="Contagem Clientes")
PT.AddDataField Field:="Contagem Clientes", Caption:="Contagem Clientes"