Run Time Error '438' Code Suggestions?

Hello,

I have the following code:

Sub VBF()
'
' VBF Macro
'
    
Dim strSQL As String

  strSQL = "select count(distinct contact_number)" & vbNewLine _
         & "from    contact_categories" & vbNewLine _
         & "where   activity = 'SUPP'" & vbNewLine _
         & "and      activity_value in ('HLEG','HL','HLU')" & vbNewLine _
         & "and     valid_from between '01-Nov-2009' and '30-Nov-2009'"
  Call AddList("MH4L", "zMH4L", strSQL)

  strSQL = "select count(distinct contact_number)" & vbNewLine _
           & "from    contact_categories" & vbNewLine _
           & "where   activity = 'SUPP'" & vbNewLine _
           & "and      activity_value in ('HLEG','HL','HLU')" & vbNewLine _
           & "and      valid_from <= '30-Nov-2009'" & vbNewLine _
           & "and        valid_to >= '30-Nov-2009'"
  Call AddList("Total H4L", "zTH4L", strSQL)
 
 
  strSQL = "select count(distinct contact_number)" & vbNewLine _
         & "from    contact_categories" & vbNewLine _
         & "where   activity = 'SUPP'" & vbNewLine _
         & "and      activity_value in ('LEG','PLG')" & vbNewLine _
         & "and       valid_from between '01-Nov-2009' and '30-Nov-2009'"
  Call AddList("MLP", "zMLP", strSQL)
    
  End Sub
  
  Sub AddList(pstrSheetName As String, pstrConnectionName As String, pstrSQL As String)

Dim arrConn As Variant
    arrConn = Array(Array("ODBC;DSN=CONTLIVE3;UID=xxx;;DBQ=CONTLIVE3;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful"), _
                    Array(";NUM=NLS;DPM=F;MTS=F;MDI=F;CSR=F;FWC=F;FBS=60000;TLO=0;"))

    Sheets(pstrSheetName).Select
    With ActiveWorkbook.Connections(pstrConnectionName).ODBCConnection
        .BackgroundQuery = True
        .CommandText = pstrSQL
        .CommandType = xlCmdSql
        .Connection = arrConn
        .RefreshOnFileOpen = True
        .SavePassword = False
        .SourceConnectionFile = ""
        .SourceDataFile = ""
        .ServerCredentialsMethod = xlCredentialsMethodIntegrated
        .AlwaysUseConnectionFile = False
    End With
    With ActiveWorkbook.Connections(pstrConnectionName)
        .Name = pstrConnectionName
        .Description = ""
    End With

Do While Sheets(pstrSheetName).ListObjects.Count > 0
  Sheets(pstrSheetName).ListObjects.Remove 0

Loop

With Sheets(pstrSheetName).ListObjects.Add(SourceType:=0, Source:=arrConn, _
        Destination:=Sheets(pstrSheetName).Range("$A$1")).QueryTable
        .CommandText = pstrSQL
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = True
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_" & pstrConnectionName
        .Refresh BackgroundQuery:=False
    End With

End Sub

It seems to be erroring on:

Do While Sheets(pstrSheetName).ListObjects.Count > 0
  Sheets(pstrSheetName).ListObjects.Remove 0

Loop

I have tried changing the second line to a 1 but with no luck, googling and browsing forums it has suggested to 'set' the worksheets but with no luck.

Any help would be appreciated!

Happy 2010!

Andy

Try

Sheets(pstrSheetName).ListObjects(1).Unlist

or

Sheets(pstrSheetName).ListObjects(1).Delete