2014-10-09 40 views
0

有没有方法可以查找数组中的物品数量?VBA代码查找阵列中物品的数量

我的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 

回答

0

试试这个(不同于你的方法,但经得起考验的,假设所有的文本文件,包括调用工作簿驻留在同一个文件夹):

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 

NB If作品你then马克的答案else评论end if