Colegas, boa tarde.

Mais uma vez recorro aos experts do forum para um impasse...

Tenho uma rotina para descompactar arquivos .Zip, mas ela simplesmente não executa a descompactação.

O estranho é que na compilação não aponta erros, e nem mesmo na execução, mas os arquivos permanecem sem liberar os outros (no caso .csv), que estão compactados.

Segue a rotina, solicitando que alguém possa me informar onde está a falha, pois já fiz várias tentativas de alteração e não encontrei a solução.

Agradeço qualquer ajuda possível.

Abraços a todos.

Sub UnzipArqs()
    Dim FSO, oApp                                           As Object
    Dim Dados()                                             As Byte
    Dim FileNameFolder, Fname, DefPath, Arquivo, arNames()  As Variant
    Dim iFileNumber                                         As Long
    Dim myCount, A                                          As Integer
    Dim AnoRef, MesRef                                      As String
    
If Month(Date) = 1 Then
   MesRef = CStr(Year(Date) - 1 & Format(Month(Date) - 1, "00"))
Else
   MesRef = CStr(Year(Date) & Format(Month(Date) - 1, "00"))
End If
    
    AnoRef = Left(MesRef, 4)
    
    DefPath = "C:\_Meus Documentos\Planilhas\Testes\Arq_CSV\" & AnoRef & "\" & MesRef
     
    Fname = Dir("C:\_Meus Documentos\Planilhas\Testes\Arq_CSV\" & AnoRef & "\" & MesRef & "\*.zip")
     
Do Until Fname = ""
    myCount = myCount + 1
    ReDim Preserve arNames(1 To myCount)
    arNames(myCount) = Fname
    Fname = Dir
Loop

If Not IsArray(arNames) Then
    MsgBox "Não existem arquivos a serem trataos"
    Exit Sub
End If

For A = LBound(arNames) To UBound(arNames)
    
    Arquivo = DefPath & arNames(A)
    
    iFileNumber = FreeFile
    Open Arquivo For Binary Access Write As #iFileNumber
    Put #iFileNumber, 1, Dados
    Close #iFileNumber

    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If
     
    FileNameFolder = DefPath
 
    Set oApp = CreateObject("Shell.Application")
        oApp.Namespace("C:\_Meus Documentos\Planilhas\Testes\Arq_CSV\" & AnoRef & "\" & MesRef & "\" & arNames(A)).Items
        
Next A
    
End Sub