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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.