Can't remember where I ripped this code from but it was from one of the member here helping to shredd a file. I tweaked my code to my needs. Can you check and let me know the logic.

Code:
    ' Open file
    Dim intFreeFile As Integer
    intFreeFile = FreeFile
    Open strShredFile For Binary As #intFreeFile
        
    ' Get total length
    Dim lngLOF As Long
    lngLOF = LOF(intFreeFile)
    
    ' Allocate buffer size for array byte
    Const cintMAXSize As Integer = 1024 '* 4 '32& * 1024&
    Dim intBufferSize As Integer
    intBufferSize = IIf(lngLOF > cintMAXSize, cintMAXSize, lngLOF)
    
    Dim byteArr() As Byte
    Dim strData As String
    Dim lngPos As Long
    lngPos = 1
    Seek #intFreeFile, 1
    Do
        ' Allocate byteArr
        Erase byteArr
        If (lngPos + intBufferSize) >= lngLOF Then  'Test if Final looping - this need to be tested first - good methodology
            ReDim byteArr(lngLOF - lngPos)
        Else                                        'Continuous looping
            ReDim byteArr(intBufferSize)
        End If
        
        Get #intFreeFile, lngPos, byteArr
        strData = LCase(byteArr)
        
        Dim intCounter As Integer
        Dim intPos As Integer
        Do
            intPos = InStr(intPos + 1, strData, "winxml", vbBinaryCompare)
            If intPos = 0 Then Exit Do
            
            intCounter = intCounter + 1
        Loop
        
        ' Return write position
        lngPos = lngPos + intBufferSize - (Len("winxml") * 2)
    Loop Until lngPos >= lngLOF
    Close #intFreeFile