Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

COUPEUR DE FICHIERS


Information sur la source

Description

Cliquez pour voir la capture en taille normale
Cette sources permet de couper des fichiers, et créer un .bat permettant de la reconstruire.
Cette source est pour les débutants.
 

Source

  • Option Explicit
  • Private file_open, dir_out As String
  • Private ascii() As Variant
  • Private Sub CommandButton1_Click()
  • Dim o As MSComDlg.CommonDialog
  • Dim tmq, tmp As String
  • Dim i As Long
  • 'initialisation de l'objet
  • Set o = Me.Controls.Add("MSComDlg.CommonDialog", "Essai")
  • o.InitDir = App.Path
  • o.Filter = "*|*.*"
  • 'Methode de l'objet
  • o.ShowOpen
  • file_open = o.FileName
  • 'ouvrir et reup si erreur le fichier exel
  • 'permet d'afficher une fenetre de sauvegarde
  • 'O.ShowSave
  • 'Debug.Print "SAUVE :"; O.FileName
  • 'Propiete
  • 'tmp = O.FileName
  • Text1.Text = file_open
  • Me.Controls.Remove ("Essai")
  • Set o = Nothing
  • End Sub
  • Private Sub CommandButton2_Click()
  • Dim F As Object
  • Dim fs As Object
  • Dim fol As String
  • Dim i, j As Integer
  • 'le $ sert a dire que string = dim a as string
  • Dim flagchoix&, msg$, racine&
  • 'flagchoix = &H1&: msg = "Choissisez un dossier :"
  • 'Set fs = CreateObject("Shell.Application")
  • 'Set f = fs.BrowseForFolder(&H0&, msg, flagchoix)
  • 'If Not f Is Nothing Then
  • ' If InStr(1, f.ParentFolder.parsename(f.Title).Path, ":", vbTextCompare) <> 0 Then
  • ' dir_out = f.ParentFolder.parsename(f.Title).Path
  • ' Text2 = dir_out
  • ' Else
  • ' MsgBox "Veuillez sélectionner un répertoire valide"
  • ' End If
  • 'End If
  • flagchoix = &H1&: msg = "Select a folder :"
  • Set fs = CreateObject("Shell.Application")
  • Set F = fs.BrowseForFolder(&H0&, msg, flagchoix)
  • If Not F Is Nothing Then
  • dir_out = F.self.Path
  • Text2 = dir_out
  • Else
  • MsgBox "Veuillez sélectionner un répertoire valide"
  • End If
  • End Sub
  • Private Sub Form_Load()
  • Text3 = "1,44"
  • file_open = ""
  • dir_out = ""
  • Call import_table_ascii
  • 'Text1 = "01-sweet and tangy.mp3"
  • file_open = Text1
  • 'Text2 = "C:\Temp\Nouveau dossier"
  • dir_out = Text2
  • End Sub
  • 'Private Sub CommandButton5_Click()
  • 'Dim taille_partie As Single, taille_fichier_o As Single, nb As Single, nb_partie As Single, tmp As Single
  • 'Dim i As Long
  • 'Dim fRandom As Random, fWriteRandom As Random
  • 'Dim f
  • 'Dim tp As FileSystemObject
  • 'Dim temp As String
  • 'If Text3.Text <> "" And IsNumeric(Text3.Text) And file_open <> "" And dir_out <> "" Then
  • ' taille_partie = CSng(Text3.Text) * 1024
  • ' Set tp = CreateObject("Scripting.FileSystemObject")
  • ' temp = Mid(tp.GetFileName(file_open), 1, Len(tp.GetFileName(file_open)) - 3)
  • ' Set f = tp.GetFile(file_open)
  • ' taille_fichier_o = f.Size
  • ' Set f = Nothing
  • ' Set tp = Nothing
  • ' 'file random
  • ' Set fRandom = New Random
  • ' Set fWriteRandom = New Random
  • ' fRandom.OpenFile file_open
  • ' fRandom.SeekAbsolute 0, 1 ' Seeks 2 bytes (0*2^32 + 2) = 1 character.
  • '' f.SeekRelative -2 ' Seeks backward 1 character.
  • ' nb_partie = taille_fichier_o / taille_partie
  • ' nb = 0
  • ' tmp = 0
  • ' fWriteRandom.OpenFile dir_out & "\" & file_open & "." & nb
  • ' While nb <> taille_fichier_o - 1
  • ' temp = fRandom.ReadBytes(1)
  • ' If taille_fichier_o Mod taille_partie And nb <> 0 Then
  • ' tmp = tmp + 1
  • ' fWriteRandom.CloseFile
  • ' fWriteRandom.SeekAbsolute 0, 8
  • ' fWriteRandom.SeekAbsolute 0, 8
  • ' End If
  • ' fWriteRandom.WriteBytes temp
  • ' nb = nb + taille_fichier_o
  • ' Wend
  • 'End If
  • 'End Sub
  • Private Sub CommandButton5_Click()
  • Dim taille_partie, taille_fichier_o, nb As Long
  • Dim tp As FileSystemObject
  • Dim F
  • Dim j, k, L As Integer
  • Dim Temp, new_file, ext_name, txt As String
  • Dim Data As Variant
  • Dim datawrite() As Byte
  • Dim fRandom As Random, fWriteRandom As Random
  • On Error GoTo error
  • If Text3.Text <> "" And IsNumeric(Text3.Text) And file_open <> "" And dir_out <> "" Then
  • 'test si il n'ya que 2 decimale
  • If Round(CDbl(Text3.Text), 2) = CDbl(Text3.Text) Then
  • taille_partie = CSng(Text3.Text) * 1024 * 1024
  • Set tp = CreateObject("Scripting.FileSystemObject")
  • Temp = Mid(tp.GetFileName(file_open), 1, Len(tp.GetFileName(file_open)) - 3)
  • ext_name = tp.GetExtensionName(file_open)
  • Set F = tp.GetFile(file_open)
  • taille_fichier_o = F.Size
  • If taille_fichier_o > taille_partie Then
  • j = Fix(taille_fichier_o / taille_partie) 'donne le nombre de partie entière
  • 'couper le fichier
  • new_file = dir_out & "\" & Temp
  • k = 0
  • Set fRandom = New Random
  • Set fWriteRandom = New Random
  • 'fRandom.CloseFile
  • fRandom.OpenFile (F.Path)
  • While k <> j
  • ' If k * taille_partie < 2147483647 Then
  • ' fRandom.SeekAbsolute k * taille_partie, (k + 1) * taille_partie
  • ' Else
  • ' fRandom.SeekAbsolute -2147483647 - k * taille_partie - 2147483647, (k + 1) * taille_partie
  • ' End If
  • Data = fRandom.ReadBytes(taille_partie)
  • fWriteRandom.OpenFile new_file & k
  • datawrite = Data
  • fWriteRandom.WriteBytes datawrite()
  • fWriteRandom.CloseFile
  • k = k + 1
  • Wend
  • ' If k * taille_partie < 2147483647 Then
  • ' fRandom.SeekAbsolute k * taille_partie, (k + 1) * taille_partie
  • ' Else
  • ' fRandom.SeekAbsolute -2147483647 - k * taille_partie - 2147483647, (k + 1) * taille_partie
  • ' End If
  • If k * taille_partie <> taille_fichier_o Then
  • ' fRandom.SeekAbsolute k * taille_partie, taille_fichier_o
  • Data = fRandom.ReadBytes(taille_fichier_o - k * taille_partie)
  • fWriteRandom.OpenFile new_file & k
  • datawrite = Data
  • fWriteRandom.WriteBytes datawrite()
  • fWriteRandom.CloseFile
  • End If
  • ' Open file_open For Binary Access Read As #1
  • ' Do While Not EOF(1)
  • ' If taille_fichier_mo <> taille_partie * j And k = j Then
  • ' Data = ""
  • ' Data = String(f.Size - j * Fix(taille_partie * 1024 * 1024), " ")
  • ' End If
  • ' If k <= j Then
  • ' Open new_file & k For Binary Access Write As #2
  • ' Get #1, , Data
  • ' Put #2, , Data
  • ' Close #2
  • ' k = k + 1
  • ' Else
  • ' GoTo 1:
  • ' End If
  • ' Loop
  • '1:
  • ' Close #1
  • 'cration du .bat copy all partie to ancien nom fichier
  • Open new_file & "bat" For Output As #1
  • 'Print #1, "Echo off"
  • txt = ""
  • For L = 0 To k
  • txt = txt & " + """ & Temp & L & """"
  • Next L
  • txt = txt & " """ & Temp & ext_name & """"
  • 'Print #1, "Copy /b " & Mid(txt, 4, Len(txt) - 3)
  • 'Print #1, "Echo ""Fichier reconstitue"""
  • 'Print #1, "pause"
  • txt = "Echo off" & Chr(10) & _
  • "Copy /b " & Mid(txt, 4, Len(txt) - 3) & Chr(10) & _
  • "Echo ""Fichier reconstitué""" & Chr(10) & _
  • "pause"
  • Call replace_str(txt)
  • Print #1, txt
  • Close #1
  • If taille_fichier_o <> taille_partie * j Then
  • nb = j + 1
  • Else
  • nb = j
  • End If
  • MsgBox "Travail terminé : " & nb & " Parties crées pour " & Round((taille_fichier_o / 1024) / 1024, 2) & " Mo"
  • Set F = Nothing
  • Set tp = Nothing
  • Else
  • MsgBox ("La taille des parties est inférieur ou egale a celle du fichier")
  • End If
  • Else
  • MsgBox ("La taille en Mo ne doit contenir que 2 chiffre apres la virgule")
  • End If
  • Else
  • MsgBox "Veuillez Renseigner tous les champs. Attention : " & Chr(13) & "utiliser une virgule pour la taille (Ex : 1,44)."
  • End If
  • Set fRandom = Nothing
  • Set fWriteRandom = Nothing
  • Exit Sub
  • error:
  • MsgBox Err.Number & " " & Err.Description
  • Set fRandom = Nothing
  • Set fWriteRandom = Nothing
  • End Sub
  • 'old
  • 'Private Sub CommandButton5_Click()
  • 'Dim taille_partie, taille_fichier_mo, nb As Double
  • 'Dim tp As FileSystemObject
  • 'Dim f
  • 'Dim j, k, L As Integer
  • 'Dim temp, new_file, ext_name, txt As String
  • 'Dim Data As String
  • '
  • 'If Text3.Text <> "" And IsNumeric(Text3.Text) And file_open <> "" And dir_out <> "" Then
  • ' 'test si il n'ya que 2 decimale
  • ' If Round(CDbl(Text3.Text), 2) = CDbl(Text3.Text) Then
  • '
  • ' taille_partie = CSng(Text3.Text)
  • ' Set tp = CreateObject("Scripting.FileSystemObject")
  • ' temp = Mid(tp.GetFileName(file_open), 1, Len(tp.GetFileName(file_open)) - 3)
  • ' ext_name = tp.GetExtensionName(file_open)
  • ' Set f = tp.GetFile(file_open)
  • ' taille_fichier_mo = Round(CDbl(CDbl(f.Size / 1024) / 1024), 2)
  • ' If taille_fichier_mo > taille_partie Then
  • ' j = Fix(taille_fichier_mo / taille_partie) 'donne le nombre de partie entière
  • ' 'couper le fichier
  • ' new_file = dir_out & "\" & temp
  • ' Data = String(Fix(taille_partie * 1024 * 1024), " ")
  • ' k = 0
  • ' Open file_open For Binary Access Read As #1
  • ' Do While Not EOF(1)
  • ' If taille_fichier_mo <> taille_partie * j And k = j Then
  • ' Data = ""
  • ' Data = String(f.Size - j * Fix(taille_partie * 1024 * 1024), " ")
  • ' End If
  • ' If k <= j Then
  • ' Open new_file & k For Binary Access Write As #2
  • ' Get #1, , Data
  • ' Put #2, , Data
  • ' Close #2
  • ' k = k + 1
  • ' Else
  • ' GoTo 1:
  • ' End If
  • ' Loop
  • '1:
  • ' Close #1
  • ' 'cration du .bat copy all partie to ancien nom fichier
  • ' Open new_file & "bat" For Output As #1
  • ' 'Print #1, "Echo off"
  • ' txt = ""
  • ' For L = 0 To k - 1
  • ' txt = txt & " + """ & temp & L & """"
  • ' Next L
  • ' txt = txt & " """ & temp & ext_name & """"
  • ' 'Print #1, "Copy /b " & Mid(txt, 4, Len(txt) - 3)
  • ' 'Print #1, "Echo ""Fichier reconstitue"""
  • ' 'Print #1, "pause"
  • ' txt = "Echo off" & Chr(10) & _
  • ' "Copy /b " & Mid(txt, 4, Len(txt) - 3) & Chr(10) & _
  • ' "Echo ""Fichier reconstitué""" & Chr(10) & _
  • ' "pause"
  • ' Call replace_str(txt)
  • ' Print #1, txt
  • ' Close #1
  • ' If taille_fichier_mo <> taille_partie * j Then
  • ' nb = j + 1
  • ' Else
  • ' nb = j
  • ' End If
  • ' MsgBox "Travail terminé : " & nb & " Parties crées pour " & taille_fichier_mo & " Mo"
  • ' Set f = Nothing
  • ' Set tp = Nothing
  • ' Else
  • ' MsgBox ("La taille des parties est inférieur ou egale a celle du fichier")
  • ' End If
  • ' Else
  • ' MsgBox ("La taille en Mo ne doit contenir que 2 chiffre apres la virgule")
  • ' End If
  • 'Else
  • ' MsgBox "Veuillez Renseigner tous les champs. Attention : " & Chr(13) & "utiliser une virgule pour la taille (Ex : 1,44)."
  • 'End If
  • 'End Sub
  • Public Sub import_table_ascii()
  • Dim txt As String
  • Dim i, j As Integer
  • ReDim ascii(127, 1)
  • Open App.Path & "\table.txt" For Input As #1
  • i = 0
  • Do While Not EOF(1)
  • Input #1, txt
  • j = InStr(1, txt, Chr(9), vbTextCompare)
  • ascii(i, 0) = Mid(txt, 1, j - 1)
  • ascii(i, 1) = Mid(txt, j + 1, Len(txt) - j)
  • i = i + 1
  • Loop
  • Close #1
  • End Sub
  • Public Sub replace_str(ByRef txt As String)
  • Dim i, t As Long
  • For i = 1 To Len(txt)
  • t = Asc(Mid(txt, i, 1))
  • If t > 127 Then
  • If IsNumeric(ascii(t - 128, 1)) Then
  • Mid(txt, i, 1) = Chr(ascii(t - 128, 1))
  • End If
  • End If
  • Next i
  • End Sub
Option Explicit
Private file_open, dir_out As String
Private ascii() As Variant

Private Sub CommandButton1_Click()
Dim o As MSComDlg.CommonDialog
Dim tmq, tmp As String
Dim i As Long
    'initialisation de l'objet
    Set o = Me.Controls.Add("MSComDlg.CommonDialog", "Essai")
    o.InitDir = App.Path
    o.Filter = "*|*.*"
    'Methode de l'objet
    o.ShowOpen
    file_open = o.FileName
    'ouvrir et reup si erreur le fichier exel
    'permet d'afficher une fenetre de sauvegarde
    'O.ShowSave
    'Debug.Print "SAUVE :"; O.FileName
    'Propiete
    'tmp = O.FileName
    Text1.Text = file_open
    Me.Controls.Remove ("Essai")
    Set o = Nothing
    
End Sub

Private Sub CommandButton2_Click()
Dim F As Object
Dim fs As Object
Dim fol As String
Dim i, j As Integer
'le $ sert a dire que string = dim a as string
Dim flagchoix&, msg$, racine&

'flagchoix = &H1&: msg = "Choissisez un dossier :"
'Set fs = CreateObject("Shell.Application")
'Set f = fs.BrowseForFolder(&H0&, msg, flagchoix)
'If Not f Is Nothing Then
'    If InStr(1, f.ParentFolder.parsename(f.Title).Path, ":", vbTextCompare) <> 0 Then
'    dir_out = f.ParentFolder.parsename(f.Title).Path
'    Text2 = dir_out
'    Else
'    MsgBox "Veuillez sélectionner un répertoire valide"
'    End If
'End If
flagchoix = &H1&: msg = "Select a folder :"
Set fs = CreateObject("Shell.Application")
Set F = fs.BrowseForFolder(&H0&, msg, flagchoix)
If Not F Is Nothing Then
    dir_out = F.self.Path
    Text2 = dir_out
Else
    MsgBox "Veuillez sélectionner un répertoire valide"
End If

End Sub

Private Sub Form_Load()
    Text3 = "1,44"
    file_open = ""
    dir_out = ""
    Call import_table_ascii
    'Text1 = "01-sweet and tangy.mp3"
    file_open = Text1
    'Text2 = "C:\Temp\Nouveau dossier"
    dir_out = Text2
End Sub

'Private Sub CommandButton5_Click()
'Dim taille_partie As Single, taille_fichier_o As Single, nb As Single, nb_partie As Single, tmp As Single
'Dim i As Long
'Dim fRandom As Random, fWriteRandom As Random
'Dim f
'Dim tp As FileSystemObject
'Dim temp As String
'If Text3.Text <> "" And IsNumeric(Text3.Text) And file_open <> "" And dir_out <> "" Then
'    taille_partie = CSng(Text3.Text) * 1024
'    Set tp = CreateObject("Scripting.FileSystemObject")
'    temp = Mid(tp.GetFileName(file_open), 1, Len(tp.GetFileName(file_open)) - 3)
'    Set f = tp.GetFile(file_open)
'    taille_fichier_o = f.Size
'    Set f = Nothing
'    Set tp = Nothing
'    'file random
'    Set fRandom = New Random
'    Set fWriteRandom = New Random
'    fRandom.OpenFile file_open
'    fRandom.SeekAbsolute 0, 1     ' Seeks 2 bytes (0*2^32 + 2) = 1 character.
''    f.SeekRelative -2       ' Seeks backward 1 character.
'    nb_partie = taille_fichier_o / taille_partie
'    nb = 0
'    tmp = 0
'    fWriteRandom.OpenFile dir_out & "\" & file_open & "." & nb
'    While nb <> taille_fichier_o - 1
'        temp = fRandom.ReadBytes(1)
'        If taille_fichier_o Mod taille_partie And nb <> 0 Then
'            tmp = tmp + 1
'            fWriteRandom.CloseFile
'            fWriteRandom.SeekAbsolute 0, 8
'            fWriteRandom.SeekAbsolute 0, 8
'        End If
'        fWriteRandom.WriteBytes temp
'        nb = nb + taille_fichier_o
'    Wend
'End If
'End Sub
Private Sub CommandButton5_Click()
Dim taille_partie, taille_fichier_o, nb As Long
Dim tp As FileSystemObject
Dim F
Dim j, k, L As Integer
Dim Temp, new_file, ext_name, txt As String
Dim Data As Variant
Dim datawrite() As Byte
Dim fRandom As Random, fWriteRandom As Random
On Error GoTo error

If Text3.Text <> "" And IsNumeric(Text3.Text) And file_open <> "" And dir_out <> "" Then
    'test si il n'ya que 2 decimale
    If Round(CDbl(Text3.Text), 2) = CDbl(Text3.Text) Then
        taille_partie = CSng(Text3.Text) * 1024 * 1024
        Set tp = CreateObject("Scripting.FileSystemObject")
        Temp = Mid(tp.GetFileName(file_open), 1, Len(tp.GetFileName(file_open)) - 3)
        ext_name = tp.GetExtensionName(file_open)
        Set F = tp.GetFile(file_open)
        taille_fichier_o = F.Size
        If taille_fichier_o > taille_partie Then
            j = Fix(taille_fichier_o / taille_partie) 'donne le nombre de partie entière
            'couper le fichier
            new_file = dir_out & "\" & Temp
            k = 0
            Set fRandom = New Random
            Set fWriteRandom = New Random
            'fRandom.CloseFile
            fRandom.OpenFile (F.Path)
            While k <> j
'                If k * taille_partie < 2147483647 Then
'                    fRandom.SeekAbsolute k * taille_partie, (k + 1) * taille_partie
'                Else
'                    fRandom.SeekAbsolute -2147483647 - k * taille_partie - 2147483647, (k + 1) * taille_partie
'                End If
                Data = fRandom.ReadBytes(taille_partie)
                fWriteRandom.OpenFile new_file & k
                datawrite = Data
                fWriteRandom.WriteBytes datawrite()
                fWriteRandom.CloseFile
                k = k + 1
            Wend
'            If k * taille_partie < 2147483647 Then
'                fRandom.SeekAbsolute k * taille_partie, (k + 1) * taille_partie
'            Else
'                fRandom.SeekAbsolute -2147483647 - k * taille_partie - 2147483647, (k + 1) * taille_partie
'            End If
            If k * taille_partie <> taille_fichier_o Then
'            fRandom.SeekAbsolute k * taille_partie, taille_fichier_o
            Data = fRandom.ReadBytes(taille_fichier_o - k * taille_partie)
            fWriteRandom.OpenFile new_file & k
            datawrite = Data
            fWriteRandom.WriteBytes datawrite()
            fWriteRandom.CloseFile
            End If
'            Open file_open For Binary Access Read As #1
'            Do While Not EOF(1)
'                If taille_fichier_mo <> taille_partie * j And k = j Then
'                    Data = ""
'                    Data = String(f.Size - j * Fix(taille_partie * 1024 * 1024), " ")
'                End If
'                If k <= j Then
'                Open new_file & k For Binary Access Write As #2
'                Get #1, , Data
'                Put #2, , Data
'                Close #2
'                k = k + 1
'                Else
'                GoTo 1:
'                End If
'            Loop
'1:
'            Close #1
            'cration du .bat copy all partie to ancien nom fichier
            Open new_file & "bat" For Output As #1
            'Print #1, "Echo off"
            txt = ""
            For L = 0 To k
                txt = txt & " + """ & Temp & L & """"
            Next L
            txt = txt & " """ & Temp & ext_name & """"
            'Print #1, "Copy /b " & Mid(txt, 4, Len(txt) - 3)
            'Print #1, "Echo ""Fichier reconstitue"""
            'Print #1, "pause"
            txt = "Echo off" & Chr(10) & _
                  "Copy /b " & Mid(txt, 4, Len(txt) - 3) & Chr(10) & _
                  "Echo ""Fichier reconstitué""" & Chr(10) & _
                  "pause"
                Call replace_str(txt)
                Print #1, txt
            Close #1
            If taille_fichier_o <> taille_partie * j Then
            nb = j + 1
            Else
            nb = j
            End If
            MsgBox "Travail terminé : " & nb & " Parties crées pour " & Round((taille_fichier_o / 1024) / 1024, 2) & " Mo"
            Set F = Nothing
            Set tp = Nothing
        Else
            MsgBox ("La taille des parties est inférieur ou egale a celle du fichier")
        End If
    Else
        MsgBox ("La taille en Mo ne doit contenir que 2 chiffre apres la virgule")
    End If
Else
    MsgBox "Veuillez Renseigner tous les champs. Attention : " & Chr(13) & "utiliser une virgule pour la taille (Ex : 1,44)."
End If
Set fRandom = Nothing
Set fWriteRandom = Nothing
Exit Sub
error:
MsgBox Err.Number & " " & Err.Description
Set fRandom = Nothing
Set fWriteRandom = Nothing
End Sub

'old
'Private Sub CommandButton5_Click()
'Dim taille_partie, taille_fichier_mo, nb As Double
'Dim tp As FileSystemObject
'Dim f
'Dim j, k, L As Integer
'Dim temp, new_file, ext_name, txt As String
'Dim Data As String
'
'If Text3.Text <> "" And IsNumeric(Text3.Text) And file_open <> "" And dir_out <> "" Then
'    'test si il n'ya que 2 decimale
'    If Round(CDbl(Text3.Text), 2) = CDbl(Text3.Text) Then
'
'        taille_partie = CSng(Text3.Text)
'        Set tp = CreateObject("Scripting.FileSystemObject")
'        temp = Mid(tp.GetFileName(file_open), 1, Len(tp.GetFileName(file_open)) - 3)
'        ext_name = tp.GetExtensionName(file_open)
'        Set f = tp.GetFile(file_open)
'        taille_fichier_mo = Round(CDbl(CDbl(f.Size / 1024) / 1024), 2)
'        If taille_fichier_mo > taille_partie Then
'            j = Fix(taille_fichier_mo / taille_partie) 'donne le nombre de partie entière
'            'couper le fichier
'            new_file = dir_out & "\" & temp
'            Data = String(Fix(taille_partie * 1024 * 1024), " ")
'            k = 0
'            Open file_open For Binary Access Read As #1
'            Do While Not EOF(1)
'                If taille_fichier_mo <> taille_partie * j And k = j Then
'                    Data = ""
'                    Data = String(f.Size - j * Fix(taille_partie * 1024 * 1024), " ")
'                End If
'                If k <= j Then
'                Open new_file & k For Binary Access Write As #2
'                Get #1, , Data
'                Put #2, , Data
'                Close #2
'                k = k + 1
'                Else
'                GoTo 1:
'                End If
'            Loop
'1:
'            Close #1
'            'cration du .bat copy all partie to ancien nom fichier
'            Open new_file & "bat" For Output As #1
'            'Print #1, "Echo off"
'            txt = ""
'            For L = 0 To k - 1
'                txt = txt & " + """ & temp & L & """"
'            Next L
'            txt = txt & " """ & temp & ext_name & """"
'            'Print #1, "Copy /b " & Mid(txt, 4, Len(txt) - 3)
'            'Print #1, "Echo ""Fichier reconstitue"""
'            'Print #1, "pause"
'            txt = "Echo off" & Chr(10) & _
'                  "Copy /b " & Mid(txt, 4, Len(txt) - 3) & Chr(10) & _
'                  "Echo ""Fichier reconstitué""" & Chr(10) & _
'                  "pause"
'                Call replace_str(txt)
'                Print #1, txt
'            Close #1
'            If taille_fichier_mo <> taille_partie * j Then
'            nb = j + 1
'            Else
'            nb = j
'            End If
'            MsgBox "Travail terminé : " & nb & " Parties crées pour " & taille_fichier_mo & " Mo"
'            Set f = Nothing
'            Set tp = Nothing
'        Else
'            MsgBox ("La taille des parties est inférieur ou egale a celle du fichier")
'        End If
'    Else
'        MsgBox ("La taille en Mo ne doit contenir que 2 chiffre apres la virgule")
'    End If
'Else
'    MsgBox "Veuillez Renseigner tous les champs. Attention : " & Chr(13) & "utiliser une virgule pour la taille (Ex : 1,44)."
'End If
'End Sub

Public Sub import_table_ascii()
Dim txt As String
Dim i, j As Integer
ReDim ascii(127, 1)
Open App.Path & "\table.txt" For Input As #1
i = 0
Do While Not EOF(1)
Input #1, txt
j = InStr(1, txt, Chr(9), vbTextCompare)
ascii(i, 0) = Mid(txt, 1, j - 1)
ascii(i, 1) = Mid(txt, j + 1, Len(txt) - j)
i = i + 1
Loop
Close #1
End Sub

Public Sub replace_str(ByRef txt As String)
Dim i, t As Long
For i = 1 To Len(txt)
    t = Asc(Mid(txt, i, 1))
    If t > 127 Then
        If IsNumeric(ascii(t - 128, 1)) Then
        Mid(txt, i, 1) = Chr(ascii(t - 128, 1))
        End If
    End If
Next i
End Sub

Conclusion

Utilisation pour tous les fichiers <8Go et dans la partie commentaire pour les fichiers <2Go
 

Fichier Zip

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

Commentaires et avis

signaler à un administrateur
Commentaire de Renfield le 06/05/2008 01:52:26 administrateur CS

Private file_open, dir_out As String
Dim i, j As Integer

ici, file_open et i seront des Variant.

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

Coller un fichier sur un .bat en VB.net [ par ngranier ] BonjourVoici la problématique:J'ai besoin de convertir un fichie XML dans un format bien particulier. Pour cela je dispose du fichier en .bat qui conv Identifier le code ASCII d'un caractère [ par PatBlarg ] Bonjour, j'ai chargé dans blocnotes un fichier d'un ancient logiciel DOS qui permet de créer des plaquettes d'identification sur une vieille machine. lancer fichier .bat et recuperer la sortie [ par farradjs ] Bonjour,je travail sous vb 2008 je souhaite lancer un fichier .bat ( par shell ou autre) et récuperer le resultat dans une textbox, est ce qu'il y a u creation fichier ascii [ par amel3011 ] Bonjour à tousje voudrais creer un fichier ascii et importer des données d'une base de données access vers le fichier crée !je ne sais pas par quoi co Fin de processus [ par steph064 ] Je dois exécuter mon .bat qui va me créer un .text que je vais lire juste après. Le problème c'est que lorsque je veux ouvrir ce fichier texte, visual Ouvrir un fichier ascii sur excel [ par khev ] Bonjour,Est-ce que quelqu'un pourrait me dire si c'est possible d'importer un fichier ascii sur excel en recuperant des longeur fixe dans des colonnes LOGICIEL DE CONVERSION ASCII [ par amine0911 ] Bonjour a tous,  Quelqun parmi vous connai un logiciel libre ou payant quii convertit un fichier en ASCII en un fichier normal s'il vous plait je vous Comment trier un fichier ASCII ?? [ par Cesar ] Salut,Je voudrai trier un fichier ecrit par WRITE #1,xx,xx,xx,xx,xx,etc...Il contiens a peux pres 500 ligne sur 10 colonnes.Sinon, le moyen de trier u modification de fichier ASCII [ par Cameleon ] Bonjourj'ai entendu parler que pour travailler sur des fichier il exister FileSystemObject si quelqu'un sait comment on peut y faire appel, je sais qu HELP - Import fichier Ascii [ par kaniass ] Bonjour,Je recherche le moyen d'importer dans ACCESS un fichier Ascii délimité par des virgules.Je n'y arrive pas et je craque !!!!Est-ce que quelq'un


Nos sponsors

Sondage...

CalendriCode

Juillet 2009
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Téléchargements

Logiciels à télécharger sur le même thème :

Comparez les prix Nouvelle version

Photothèque Nouveau !



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,515 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.