External table is not in the expected format Error
Hi,
About a year ago I found this site most useful in creating a connection string in a separate workbook to a table in a complex workbook, which creates a pivot cache and is therefore read-only - Ideal for what I needed.
However, my complex workbook has evolved slightly, but I can no longer form a connection to the table within it, and get the error "External table is not in the expected format"
But I can make the connection if I copy the sheet containing the table into a new workbook first - which is far from ideal.
Can anyone help me work out how to get it working again please?
Option Private Module
Option Explicit
Const conn_name = "Query from Drill Sheet Database"
Const pvt_Name = "pvt_Linked"
Dim cur_File As String, cur_Path As String, new_File As String
Sub DB_Connect()
Dim file_Exists As Boolean, file_ExistChk As String, file_ExistMsg As VbMsgBoxResult
Dim conn_Exists As Boolean, conn_ExistChk As String
Dim conn_RefreshType As Boolean, conn_RefreshChk As Integer
'Set File Link Names
cur_Path = ThisWorkbook.Path 'Current Folder
cur_File = cur_Path & "" & DATA.Range("db_FileName").Value & ".xlsm" 'Database File inc Folder
new_File = ThisWorkbook.Name 'This File Name
'Check if File Exists etc
'Code to check here...
'Check if Connection Exists
On Error Resume Next
conn_ExistChk = ThisWorkbook.Connections(conn_name).Name
If Err Then
conn_Exists = False
Else
conn_Exists = True
End If
On Error GoTo 0
'If Connection Exists then Refresh Connection String Else Create New Connection
If conn_Exists = True Then
'Check if Connection Still Matches
conn_RefreshChk = InStr(1, ThisWorkbook.Connections(conn_name).ODBCConnection.Connection, cur_File, vbTextCompare)
If conn_RefreshChk = 0 Then
'Update Connection String
ThisWorkbook.Connections(conn_name).ODBCConnection.Connection = Array("ODBC;DBQ=", cur_File, ";" _
, "DefaultDir=", cur_Path, ";" _
, "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
, "MaxBufferSize=2048;" _
, "MaxScanRows=8;" _
, "PageTimeout=50;" _
, "ReadOnly=1;" _
)
End If
'Refresh Connection & PivotTable
ThisWorkbook.Connections("Query from Drill Sheet Database").Refresh
Else
New_Connection
New_PivotTable
End If
DATA.Shapes("btn_DB_Connect").TextFrame.Characters.Text = "Update Drill Sheet Connection"
End Sub
Sub New_Connection()
'Create Connection in New Workbook
Workbooks(new_File).Connections.Add conn_name, "" _
, Array("ODBC;DBQ=", cur_File, ";" _
, "DefaultDir=", cur_Path, ";" _
, "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
, "MaxBufferSize=2048;" _
, "MaxScanRows=8;" _
, "PageTimeout=50;" _
, "ReadOnly=1;" _
), _
Array("SELECT * " & Chr(13) & "" & Chr(10) & "FROM Data$
Data$
"), 2
End Sub
Sub New_PivotTable()
Dim pvt_Dest As String
Application.ScreenUpdating = False
'Create Pivot Table with Connection in DATA Sheet
pvt_Dest = DATA.Name & "!R10C1"
'THIS IS LINE WHERE IT ERRORS
ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal _
, SourceData:=ActiveWorkbook.Connections(conn_name)) _
.CreatePivotTable TableDestination:=pvt_Dest _
, TableName:=pvt_Name
'Sets Refresh as PivotCache Create Removes Refresh Settings
With ActiveWorkbook.Connections(conn_name).ODBCConnection
.BackgroundQuery = True
.RefreshOnFileOpen = True
End With
With ActiveSheet.PivotTables(pvt_Name)
'Formatting PivotTable
End With
Application.ScreenUpdating = True
End Sub