Question

此代码(Source)用于将多个文本文件放在同一个文件夹中，并从每个文件中创建一个单独的工作表。它适用于一个文件，但是当它在第二个文件上执行时，我会在标题中看到错误消息。

我相信所有变量都已设置，我尝试在循环中设置变量，同时移动增量器，并将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

上面的代码和一些不必要的行看起来有几个问题。获取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。

这就是问题所在。

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

2 个答案: