Excel VBA - ワークシートを分離するためのテキストファイル：オブジェクト変数またはブロック変数が設定されていない

Question

このコード(Source)は、複数のテキストファイルをすべて同じフォルダに入れ、それぞれ個別のワークシートを作成します。これは1つのファイルに対して機能しますが、2番目のファイルで実行するときに、タイトルにエラーメッセージが表示されます。

私はすべての変数が設定されていると思いますし、ループ内で変数を設定して、インクリメンタを動かしてxTempWb.Sheets(1).CopyをxTempWb.Sheets(1).Addに変更してみました。私はまた、Stack Overflowに関する多くの質問とMSDNのドキュメントを参考にしました。

それはラインでのエラーハンドラにジャンプ：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

上記のコードといくつかのunncessary線でいくつかの問題があるように見えます。 xFilesTopOpenを取得した後、コードを以下に調整してください。

xTempWbのスペルが間違っている場所がありました。また、xTembWBとしてください。コードの上にOption Explicitを使用すると、すべての変数の名前が必要に応じて指定されます。

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

使用

Option Explicit

---

あなたはDim xTempWb As Workbook を宣言している、あなたはSet xTembWb = Workbooks.Open(xFilesToOpen(I))にテキストファイルを設定してから、もう一度xTempWbを使用しようとしています。

これは問題です。