Const myExt = "slc" 'расширение у файлов
Const SlicePart =  1048576  *  2  'размер куска

'Декларируем:
Public Type OpenFilename
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(ByRef pOpenfilename As OpenFilename) As Boolean

Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

'Аргументы: sTitle - строка которую выводим в заголовке формы открытия файла
'Назначение: Вывод диалогового окна открытия файла
'Возвращает: Строку - путь к выбранному файлу
Public Function GetFile(Optional sFlt As String = "", Optional sTitle As String = "Открыть файл") As String
Dim of As OpenFilename
Dim pos As Integer

GetFile = ""
of.lStructSize = Len(of)
'of.hwndOwner = Application.hWndExcelApp
If sFlt = "" Then sFlt = "ZIP Files (*.zip)" & Chr$( 0 ) & "*.zip"
of.lpstrFilter = sFlt ' "ZIP Files (*.zip)" & Chr$(0) & "*.zip" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*"
of.nFilterIndex =  1 
of.lpstrFile = String$( 512 ,  0 )
of.nMaxFile =  511 
of.lpstrDefExt = "mdb"
of.lpstrTitle = sTitle

If GetOpenFileName(of) Then
pos = InStr( 1 , of.lpstrFile, Chr$( 0 ))
GetFile = Left(of.lpstrFile, pos -  1 )
End If
End Function

Sub Slice()
Dim sFileIn, sFileOut, lngFileLen, LastSliceLen, j, MaxJ
Dim VarString As String
Dim a, b, c
On Error GoTo err_slice

sFileIn = GetFile()
If sFileIn = "" Then Exit Sub

DivideFileName sFileIn, a, b, c
sFileOut = ActiveWorkbook.Path & "\" & b & "."

On Error Resume Next
Kill sFileOut & "*"
On Error GoTo err_slice

VarString = String(SlicePart, " ")
Open sFileIn For Binary Access Read As  1 
lngFileLen = LOF( 1 )
MaxJ = lngFileLen \ SlicePart
LastSliceLen = lngFileLen Mod SlicePart

For j =  1  To MaxJ
Open sFileOut & CalcExt(j) For Binary Access Write As  2 
Get # 1 , , VarString
Put # 2 , , VarString
Close  2 
Next
'last part
If LastSliceLen >  0  Then
VarString = String(LastSliceLen, " ")
Open sFileOut & CalcExt(MaxJ +  1 ) For Binary Access Write As  2 
Get # 1 , , VarString
Put # 2 , , VarString
Close  2 
End If

ext_slice:
Close  2 
Close  1 
Exit Sub

err_slice:

MsgBox "ERROR: " & Err.Number & Err.Description & vbCrLf & "Terminating execution.", vbCritical, "ERROR!"

Resume ext_slice
End Sub

Function CalcExt(PartNo)
'выдать расширение
If PartNo =  1  Then
CalcExt = myExt
Else
CalcExt = Left(myExt,  1 ) + Format(PartNo -  1 , "00")
End If
End Function

Sub UnSlice()
Dim sFileIn, curFileIn, sFileOut, lngFileLen, LastSliceLen, j, MaxJ
Dim VarString As String
Dim a, b, c
On Error GoTo err_slice

sFileIn = GetFile("SLICED Files (*.slc)" & Chr$( 0 ) & "*.slc")
If sFileIn = "" Then Exit Sub

DivideFileName sFileIn, a, b, c
sFileIn = a & b & "."
sFileOut = ActiveWorkbook.Path & "\" & b & ".zip"

'Kill sFileOut & "*"

Open sFileOut For Binary Access Write As  2 

Do
    j = j +  1 
    curFileIn = sFileIn & CalcExt(j)
    If Dir(curFileIn) <> "" Then 'это еще не конец
        Open curFileIn For Binary Access Read As  1 
        
        lngFileLen = LOF( 1 )
        VarString = String(lngFileLen, " ")
        
        Get # 1 , , VarString
        Put # 2 , , VarString
        Close  1 
        Debug.Print curFileIn & " OK"
    Else
        Exit Do
    End If

Loop

ext_slice:
Close  2 
Close  1 
Exit Sub

err_slice:
MsgBox "ERROR: " & Err.Number & Err.Description & vbCrLf & "Terminating execution.", vbCritical, "ERROR!"
Resume ext_slice
End Sub

Sub DivideFileName(sIn, sDir, sFile, sExt)

Dim tmp, j

'получить путь со слэшем
tmp = sIn
For j = Len(tmp) To  3  Step - 1 
If Mid(tmp, j,  1 ) = "\" Then Exit For
Next

sDir = Left(tmp, j)

'получить расширение, на входе имя файла
tmp = Right(sIn, Len(sIn) - Len(sDir))
For j = Len(tmp) To  3  Step - 1 
If Mid(tmp, j,  1 ) = "." Then Exit For
Next

sExt = Right(tmp, Len(tmp) - j)
'имя файла
sFile = Left(tmp, Len(tmp) - Len(sExt) -  1 )



End Sub

Sub testDiv(sPath)
Dim a, b, c
DivideFileName sPath, a, b, c
Debug.Print "D=" & a
Debug.Print "F=" & b
Debug.Print "E=" & c
End Sub