Ниже представленный код как я понимаю, именно то что мне нужно. Но к большому сожалению, при исполнения макроса возникает 2 проблемы, а именно:
1. Файлы после разделения файла имеют расширение .bin, например имя_файла.xlsx_001.bin
2. После изменения расширения файла, путем его переименования, и последующей открытии в Excel: "Не удается открыть файл "имя файла", так как формат или содержание этого файла является недопустимым. Убедитесь, что файл не поврежден и расширение имени соответствует его формату".
Буду признателен за помощь с кодом макроса!
Код |
---|
Sub Scorpion86rus()
Dim bytesLeft&, partSize&, b() As Byte, fileName, f%, g%, cnt&, baseName$
fileName = Application.GetOpenFilename("All files,*.*", , "Выберите файл для деления")
If fileName = False Then Exit Sub
'из полного пути выделяем имя файла с "\"
baseName = Right$(fileName, Len(fileName) - InStrRev(fileName, "\") + 1)
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Выберите папку для сохранения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
'формируем основу пути файла для сохранения из выбранной папки и имени файла для деления
baseName = .SelectedItems(1) & baseName
End With
partSize = InputBox("Введите размер части (байт)", , 5000)
f = FreeFile
Open fileName For Binary Access Read As f
bytesLeft = LOF(f) 'размер файла в байта, столько байт осталось записать
ReDim b(1 To partSize) 'буфер длиной с размер части
Do
'если длина буфера больше, чем осталось записать байт,
'делаем буфер длиной сколько байт осталось, это будет последний файл
If UBound(b) > bytesLeft Then ReDim b(1 To bytesLeft)
'уменьшаем число оставшихся байт на размер буфера
bytesLeft = bytesLeft - UBound(b)
'считываем очередной кусок файла в буфер
Get f, , b
g = FreeFile
'увеличиваем счетчик файлов на 1
cnt = cnt + 1
'записываем очередной файл
Open baseName & Format(cnt, "_000\.bin") For Binary Access Write As g
Put g, , b
Close g
'продолжаем цикл, пока осталось записать байт >0
Loop While bytesLeft
Close f
MsgBox "Записано " & cnt & " файлов", vbInformation
End Sub |