Impossibilité de supprimé une Querytable

Bonjour!

J'ai un problèmes avec une macro extrêmement basique

Dans mon fichier excel j'import des fichier .log. puis je copie et j'archive la feuille dans laquelle j'ai importé mon fichier log et je vide la feuille de structure grâce à la macro suivante:

Sub RAZ_Produit()
'
' RAZ_Produit Macro
'

'
    Range("W2:W16000").Select
    Selection.QueryTable.Delete
    Selection.ClearContents
    ActiveWorkbook.RefreshAll

End Sub

afin de pouvoir importer un nouveau log différend du premier.

Mais voila de temps en temps la macro ne marche pas et le RefreshAll fait revenir le vieux fichier log que je voulais supprimer.

Il revient même si j'import un nouveau log par dessus et ne laisse aucune trace du nouveau log.

En bonus le code VBA d'importation du log:

'Ouverture log Fiche Machine
Option Explicit

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
         "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Function GetFileName(sFilter As String, sInitialDir As String, sTitle As String) As String
  Dim OpenFile As OPENFILENAME, lReturn As Long

  With OpenFile
    .lStructSize = Len(OpenFile)
    .lpstrFilter = sFilter
    .nFilterIndex = 1
    .lpstrFile = String(257, 0)
    .nMaxFile = Len(OpenFile.lpstrFile) - 1
    .lpstrFileTitle = OpenFile.lpstrFile
    .nMaxFileTitle = OpenFile.nMaxFile
    .lpstrInitialDir = sInitialDir
    .lpstrTitle = sTitle
    .flags = 0
  End With
  lReturn = GetOpenFileName(OpenFile)

  If lReturn = 0 Then
    GetFileName = ""
  Else
     GetFileName = Trim(OpenFile.lpstrFile)
  End If

End Function

Sub Test()
  Dim sPathFic As String, sFilter As String
  sFilter = "Fichier d'export (*.log)" & Chr(0) & "*.log" & Chr(0)
  ' Donner le choix du fichier
 sPathFic = GetFileName(sFilter, "H:\Methodes\3-Fichiers par noms\Dumortier T\relevé défaut 6 axes", "Sélectionnez le fichier à ouvrir")
  If sPathFic = "" Then Exit Sub
  '
 With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPathFic, Destination:=Range("$A$2"))
    .Name = "copie"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1)
    .TextFileTrailingMinusNumbers = False
    .Refresh BackgroundQuery:=False
    Call Archivage
  End With
  End Sub

  'ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh

  Sub Archivage()
Dim SHsource As Worksheet, WBcible As Workbook

'feuille source
Set SHsource = ThisWorkbook.Sheets("TraitLOG")

'classeur cible
On Error Resume Next
Set WBcible = Workbooks.Open(Filename:="autoimport-textfile\")

'copie de la feuille source à la fin du classeur cible
SHsource.Copy After:=WBcible.Sheets(Sheets.Count)

'renommer la feuille cible
WBcible.Sheets(Sheets.Count).Name = WBcible.Sheets(Sheets.Count).Cells(2, 21)

'fermeture et sauvegarde du classeur cible
WBcible.Close True

'libération de la mémoire
Set SHsource = Nothing
Set WBcible = Nothing
  Sheets("TraitLOG").Select
  Range("A2").Select
  ActiveWorkbook.RefreshAll
End Sub

Merci d'avance de vos réponses

Bonjour Reclaimer,

Si le problème est toujours d'actualité, je propose le code :

Sub RAZ_Produit()
'
' RAZ_Produit Macro
'

'
    With ActiveSheet.Range("A2:W16000")

        .QueryTable.Delete
        .ClearContents
    End With
    ActiveWorkbook.RefreshAll

End Sub

Il est préférable dans le code VBA d'utiliser directement un objet "range" plutôt que "selection" même si lorsque l'on passe par l'enregistrement de macro, EXCEL lui génère avec "Selection".

Dans l'adresse du range j'ai remplacé "W2" par "A2" car il m'a semblé que le querytable est positionné en A2.

Bonjour!

Le problème n'est plus d'actualité mais merci de ta réponse. Le problème venait du fait que j'avait plusieurs query.tables au même endroit.

La solution que j'ai trouvé était de supprimé la première querytable dans l'onglet donné-->connexion grâce à cette macro :

  Sub RAZ_Produit()
'
' RAZ_Produit Macro
EJ:
     With ThisWorkbook.Sheets("Framework Fiche produit")
        Range("W2:W160000").Select
        On Error GoTo EH
        .QueryTables(1).Delete
        Selection.ClearContents
        ActiveWorkbook.RefreshAll
        'Set rRng = ActiveSheet.Range("W2")
    End With

GoTo EJ
EH:
   MsgBox "Suppression terminé"
EI:
'Retour fenetre en A1
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=-24

End Sub 

Lorsque que la première querytable est supprimé la deuxième devient la première et ainsi de suite jusqu'à ce qu'il n'y en ai plus à supprimer.

Encore merci de ta réponse.

Il est possible aussi de faire ainsi:

Option Explicit
Private Sub delete_all_qt()
Dim ws As Worksheet, qt As QueryTable
Set ws = ActiveSheet
For Each qt In ws.QueryTables
    If qt.Name <> "à garder" Then
        qt.Delete
    End If
Next qt
End Sub
Rechercher des sujets similaires à "impossibilite supprime querytable"