Работа с zip архивами

Private Sub Example()
    Dim FlPt$: FlPt = "D:\tmp\Zip\Diletant\Simpler Zipper Demo_\zlibwapi.zip"
    FileToBase64VBCode FlPt
End Sub
Private Sub FileToBase64VBCode(FilePath As String) '    Длина файла zlibwapi.dll 126056
    Const lineDataLen& = 900
    Const lineMaxCount& = 16
    Const sbgn$ = "B64 = _" & vbLf & """"
    Const dlm1$ = """ & _" & vbLf & """"
    Const dlm2$ = """" & vbLf & "B64 = B64 & _" & vbLf & """"
    Dim i&, fNum&, FileName$, FileDir$, B64$, sBuf$
    Dim lineCount&, rowCount&, B64Len&, lineNum&, lineLen1&, lineLen2&, pos&
    Dim sbgnLen&:   sbgnLen = Len(sbgn)
    Dim dlm1Len&:   dlm1Len = Len(dlm1)
    Dim dlm2Len&:   dlm2Len = Len(dlm2)
    Dim difDlmLen&: difDlmLen = dlm2Len - dlm1Len
    
    pos = InStrRev(FilePath, "\")
    FileName = Mid$(FilePath, pos + 1)
    FileDir = Mid$(FilePath, 1, pos)
    B64 = FileToBase64(FilePath)
    
    B64Len = Len(B64)
    lineCount = (B64Len - 1) \ lineDataLen + 1
    rowCount = (lineCount - 1) \ lineMaxCount + 1
    sBuf = String(B64Len + dlm1Len * (lineCount - 1) + difDlmLen * (rowCount - 1) + sbgnLen + 1, vbNullChar)
    lineLen1 = lineDataLen + dlm1Len
    lineLen2 = lineDataLen + dlm2Len
    
    Mid$(sBuf, 1) = sbgn
    pos = sbgnLen + 1
    lineNum = 1
    For i = 1 To B64Len - lineDataLen Step lineDataLen
        If lineNum < lineMaxCount Then
            Mid$(sBuf, pos) = Mid$(B64, i, lineDataLen) & dlm1
            pos = pos + lineLen1
            lineNum = lineNum + 1
        Else
            Mid$(sBuf, pos) = Mid$(B64, i, lineDataLen) & dlm2
            pos = pos + lineLen2
            lineNum = 1
        End If
    Next
    Mid(sBuf, pos) = Mid(B64, i) & """"
    
    fNum = FreeFile
    Open FilePath & "_B64VB.txt" For Binary Access Write As fNum
    Put fNum, , sBuf
    Close fNum
End Sub
Private Function FileToBase64(FilePath As String) As String
    Dim fNum&, fLen&, bBuf() As Byte
    
    If Len(Dir(FilePath)) = 0 Then Exit Function
    
    fNum = FreeFile
    Open FilePath For Binary Access Read As fNum
    fLen = LOF(fNum)
    ReDim bBuf(fLen - 1)
    Get fNum, , bBuf
    Close fNum
    
    With CreateObject("MSXML2.DomDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = bBuf
        FileToBase64 = Replace(.text, vbLf, vbNullString)
    End With
End Function