Excel VBA - 用于分隔工作表的文本文件:对象变量或未设置块变量

问题描述:

此代码(Source)用于获取多个文本文件,全部位于同一文件夹中,并且每个文件都有一个单独的工作表。它适用于一个文件,但是当在第二个文件上执行时,我会在标题中看到错误消息。Excel VBA - 用于分隔工作表的文本文件:对象变量或未设置块变量

我相信所有变量都设置好了,我试着在循环中设置变量,同时移动增量器并将xTempWb.Sheets(1).Copy更改为xTempWb.Sheets(1).Add。我还咨询了一些堆栈溢出问题和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 

有看起来是与上面的代码和一些unncessary线的几个问题。在获取xFilesTopOpen之后,将您的代码调整到下面。

请注意,有一个地方拼写错误xTempWbxTembWB。在代码上方使用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 
+0

即使这样也会失败。 :)代码是好的,它只是一个打字错误。不使用'Option Explicit'的经典案例 – cyboashu

+0

'xTembWb'右@cyboashu? –

+0

是的。那就对了。 – cyboashu

使用

Option Explicit


您已经声明Dim xTempWb As Workbook 和你的文本文件设置为Set xTembWb = Workbooks.Open(xFilesToOpen(I)),然后尝试再次使用xTempWb

这就是问题所在。