Function MergeFiles(bDestroy As Boolean, ByVal sDestFile As String, ParamArray aSrcFiles() As Variant) As Boolean
' bDestroy permet de choisir si on supprimer les fichiers sources
' sDestFile sera le fichier final.
' ** si il est vide, le premier fichier du tableau sera le fichier de réception
' aSrcFiles() contient les chemins des fichiers à merger.
' ** le code accepte d'avoir un tableau dans le premier fichier de source
MergeFiles = False
' tableau vide? bye
If UBound(aSrcFiles) = -1 Then Exit Function
' le paramarray contient-il des chemins, ou un tableau de chemin en 1er index?
Dim aSrc() As String
Dim i As Integer
i = VarType(aSrcFiles(0))
If (i = vbArray + vbString) Or (i = vbArray + vbVariant) Then ' tableau (8192) de string (8) ou de variant (12)
' tableau dimentionné?
i = -1
On Error Resume Next
i = UBound(aSrcFiles(0))
On Error GoTo 0
If i = -1 Then Exit Function
' on construit le tableau de destination
ReDim aSrc(LBound(aSrcFiles(0)) To UBound(aSrcFiles(0)))
For i = LBound(aSrcFiles(0)) To UBound(aSrcFiles(0))
aSrc(i) = CStr(aSrcFiles(0)(i))
Next i
ElseIf (i = vbString) Or (i = vbVariant) Then 'string (8) ou variant (12)
ReDim aSrc(LBound(aSrcFiles) To UBound(aSrcFiles))
For i = LBound(aSrcFiles) To UBound(aSrcFiles)
aSrc(i) = CStr(aSrcFiles(i))
Next i
Else 'autre type, bye
Exit Function
End If
' le tableau est créé, un fichier de destination?
If LenB(sDestFile) = 0 Then sDestFile = aSrc(LBound(aSrc))
' un seul fichier? source = destination? bye
If (sDestFile = aSrc(LBound(aSrc))) And (LBound(aSrc) = UBound(aSrc)) Then Exit Function
' création du buffer
Dim sBuffer As String, FF As Integer, sFile As String
sBuffer = vbNullString
For i = LBound(aSrc) To UBound(aSrc)
On Error Resume Next
sFile = vbCrLf
FF = FreeFile
Open aSrc(i) For Input As #FF
sFile = Input(LOF(FF), #FF)
Close #FF
If bDestroy Then Kill aSrc(i)
On Error GoTo 0
sBuffer = sBuffer & sFile
Next i
' enregistre le buffer
FF = FreeFile
Open sDestFile For Output As #FF
Print #FF, sBuffer
Close #FF
' fin
sBuffer = vbNullString
sFile = vbNullString
Erase aSrc
MergeFiles = True
End Function
'
'
' =====================
' EXEMPLE D'UTILISATION
' =====================
'
'
Private Sub Exemple()
Dim sFile1 As String
Dim sFile2 As String
Dim aFiles0() As String
Dim aFiles1(0 To 1) As String
Dim aFiles2() As Variant
sFile1 = "C:\Fichier1.txt"
sFile2 = "C:\Fichier2.txt"
aFiles1(0) = sFile1
aFiles1(1) = sFile2
aFiles2 = Array()
' 1 fichier
Debug.Print MergeFiles(False, "", sFile1) 'FAUX
' 2 fichiers (paramarray utilisé)
Debug.Print MergeFiles(False, "", sFile1, sFile2) 'VRAI
' 0 fichier (tableau string pas initialisé, paramarray pas utilisé)
Debug.Print MergeFiles(False, "", aFiles0) 'FAUX
' 2 fichiers (tableau string, paramarray pas utilisé)
Debug.Print MergeFiles(False, "C:\Fichier3.txt", aFiles1) 'VRAI
' 0 fichier (tableau variant pas initialisé, paramarray pas utilisé)
Debug.Print MergeFiles(False, "", aFiles2) 'FAUX
aFiles2 = Array(sFile1, sFile2)
' 2 fichiers (tableau variant, paramarray pas utilisé)
Debug.Print MergeFiles(False, "", aFiles2) 'VRAI
End Sub