Excel VBA - fichiers texte pour séparer des feuilles de calcul: Variable d'objet ou avec une variable de bloc non définie

Question

Ce code (Source) sert à prendre plusieurs fichiers texte, tous dans le même dossier, et à faire une feuille de calcul distincte de chacun d'eux. Cela fonctionne pour un fichier, mais quand il est temps d'exécuter sur un deuxième fichier, j'obtiens le message d'erreur dans le titre.

Je crois que toutes les variables sont définies et j'ai essayé de définir des variables dans la boucle, avec le déplacement de l'incrémenteur, et en changeant xTempWb.Sheets(1).Copy à xTempWb.Sheets(1).Add. J'ai également consulté un certain nombre de questions Stack Overflow et la documentation MSDN.

Il saute au gestionnaire d'erreur à la ligne: xTempWb.Sheets(1).Copy

Sub CombineTextFiles() 
    'update by ExtendOffice 20151015 
     Dim xFilesToOpen As Variant 
     Dim I As Integer 
     Dim xWb As Workbook 
     Dim xTempWb As Workbook 
     Dim xDelimiter As String 
     Dim xScreen As Boolean 
     On Error GoTo ErrHandler 
     xScreen = Application.ScreenUpdating 
     Application.ScreenUpdating = False 
     xDelimiter = "|" 
     xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Kutools for Excel",, True) 
     If TypeName(xFilesToOpen) = "Boolean" Then 
      MsgBox "No files were selected", . "KuTools for Excel" 
      GoTo ExitHandler 
     End If 
     I = 1 
     Set xTembWb = Workbooks.Open(xFilesToOpen(I)) 
     xTempWb.Sheets(1).Copy 
     Set xWb = Application.ActiveWorkbook 
     xTempWb.Close False 
     xWb.Worksheets(I).Columns("A:A").TextToColumns _ 
      Destination:=Range("A1"), DataType = xlDelimited, _ 
      TextQualifier:=xlDoubleQuote, _ 
      ConsecutiveDelimiter:=False, _ 
      Tab:=False, SemiColon:=False, _ 
      Comma:=False, Space:=False, _ 
      Other:=True, OtherChar:="|" 
     Do While I < UBound(xFilesToOpen) 
      I = I + 1 
      Set xTembWb = Workbooks.Open(xFilestoOpen(I)) 
      With xWb 
       xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count) 
       .Worksheets(I).Columns("A:A").TextToColumns _ 
       Destination:=Range("A1"), DataType:=xlDelimited, _ 
       TextQualifier:=xlDoubleQuote, _ 
       ConsecutiveDelimiter:=False, _ 
       Tab:=False, Semicolon:=False, _ 
       Comma:=False, Space:=False, _ 
       Other:=True, OtherChar:=xDelimiter 
      End With 
     Loop 
    ExitHandler: 
     Application.ScreenUpdating = xScreen 
     Set xWb = Nothing 
     Set xTempWb = Nothing 
     Exit Sub 
    ErrHandler 
     MsgBox Err.Description, , "KuTools For Excel" 
     Resume ExitHandler 
    End Sub 



    End Sub 
    enter code here 

Answer 1

Il semble y avoir plusieurs problèmes avec le code ci-dessus et quelques lignes unncessary. Après avoir obtenu xFilesTopOpen ajustez votre code ci-dessous.

Veuillez également noter qu'il y avait un endroit où vous avez mal orthographié xTempWb comme xTembWB. L'utilisation de Option Explicit au-dessus de votre code vous aidera à vous assurer que toutes les variables sont nommées au besoin.

Set xWB = ThisWorkbook 
Dim wbCounter as Integer 

For wbCounter = LBound(xFilesToOpen) to UBound(xFilesToOpen) 

    Set xTempWb = Workbooks.Open(xFilesToOpen(I)) 

    xTembWb.Sheets(1).Copy xWB.Worksheets(xWB.Worksheets.Count) 

    Dim ws as Worksheet 
    Set ws = Activesheet 

    ws.Columns("A:A").TextToColumns _ 
      Destination:=Range("A1"), DataType = xlDelimited, _ 
      TextQualifier:=xlDoubleQuote, _ 
      ConsecutiveDelimiter:=False, _ 
      Tab:=False, SemiColon:=False, _ 
      Comma:=False, Space:=False, _ 
      Other:=True, OtherChar:="|" 

    xTempWb.Close False 

Next 

Answer 2

Utilisez

Option Explicit

---

Vous avez déclaré Dim xTempWb As Workbook et vous configurez vos fichiers texte à Set xTembWb = Workbooks.Open(xFilesToOpen(I)) puis essayer d'utiliser une nouvelle fois xTempWb.

C'est le problème.