Question

有没有办法找到数组中的项目数？

我的txt文件列表是：

C.txt
D.txt
G.txt
H.txt

使用下面的代码我聚合了txt文件，只输出一个txt文件（output.txt）。

但是，只有当所有四个txt文件都出现在服务器的路径中时，我才需要聚合文件txt，否则我需要代码中的警告消息。

你能帮助我吗？

提前谢谢。

Option Compare Database

Dim path
Function go()
    Dim ArrTest() As Variant
    Dim I As Integer
    Dim StrFileName As String

    path = CurrentProject.Path

Ouput:
ArrTest = Array("C", "D", "G", "H")

                     file_global = "" & path & "\Output.txt"

                     fn = FreeFile
                     Open file_global For Output As fn
                     Close
                     For I = 0 To UBound(ArrTest)

                      StrFileName = "" & path & "\Output_" & ArrTest(I) & ".txt"

                      fn = FreeFile
                      Open StrFileName For Input As fn
                      Open file_global For Append As fn + 1
                      Line Input #fn, datum
                      Do While Not EOF(fn)
                        Line Input #fn, datum
                        datums = Split(datum, Chr(9))
                        For d = 0 To UBound(datums)
                            If d = 0 Then
                                datum = Trim(datums(d))
                            Else
                                datum = datum & ";" & Trim(datums(d))
                            End If
                        Next
                        Print #fn + 1, datum
                      Loop
                      Close
                     Next I

    Application.Quit
End Function

Answer 1

尝试此操作（与您的方法不同，但经过测试和测试，假设包括调用工作簿在内的所有文本文件都位于同一文件夹中）：

Option Explicit
Private Sub AppendTxtfilesConditional()
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim path As String, xp, J As Integer, I As Integer, K As Integer
Dim FSOStream As Object, FSOStream1 As Object, FSO As Object, fol As Object, fil As Object
Dim srcFile As Object, desFile As Object
Dim ArrTest() As Variant
ArrTest = Array("C", "D", "G", "H")
J = 0
path = ThisWorkbook.path
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fol = FSO.GetFolder(path)

    For I = 0 To UBound(ArrTest)
       K = 0
       For Each fil In fol.Files
           If ArrTest(I) & ".txt" = fil.Name Then
                MsgBox (ArrTest(I) & ".txt" & " is found")
                J = J + 1
                    If J > UBound(ArrTest) Then GoTo L12
                K = J
           End If
       Next

       If K = 0 Then MsgBox ArrTest(I) & ".txt" & " not found"
    Next

    MsgBox "aborted"
    GoTo final

L12:
    For I = 0 To UBound(ArrTest)
        Set srcFile = FSO.GetFile(path & "\" & ArrTest(I) & ".txt")
        On Error GoTo erLabel
        Set desFile = FSO.GetFile(path & "\Output.txt")
        On Error GoTo 0
        Set FSOStream = srcFile.OpenAsTextStream(iomode:=ForReading, Format:=TristateUseDefault)
        Set FSOStream1 = desFile.OpenAsTextStream(iomode:=ForAppending, Format:=TristateUseDefault)
            Do While Not FSOStream.AtEndOfStream
                xp = FSOStream.ReadLine
                FSOStream1.Write vbCrLf & xp ' vbCrLf & xp or 'xp & vbCrLf
            Loop
        FSOStream.Close
        FSOStream1.Close
    Next

erLabel:
    If Err.Number = 53 Then
        MsgBox "Aborted : destination file not found"
        GoTo final
    End If

final:
Set FSOStream = Nothing: Set FSOStream1 = Nothing: Set FSO = Nothing: Set fol = Nothing
Set fil = Nothing: Set srcFile = Nothing: Set desFile = Nothing
End Sub

N.B If适用于您then标记为回复else评论end if

VBA代码查找数组中的项目数

1 个答案: