2014-10-09 58 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