Deletar Pasta e Mover Arquivos

Preciso fazer uma rotina, que entre em várias pastas, move esse arquivo para dentro de uma única pasta e deleta essa pasta. É mais ou menos assim. Tenho uma pasta chamada OK. Dentro dessa pasta existe outras com o nome de cada mes(01,02,03). Dentro dela existe umas 1.000 pastas, cada uma com um único arquivo dentro dela. São essas pastas, que eu devo pegar o arquivo(.TIF) e enviara para um único diretório e depois deletar essas pastas, para não ficar com pastas vazias, já que elas não serão mais utilizadas. Essa busca deve entrar em todas as pastas que conter a pasta base(OK) e procurar pelos arquivos com extensão .TIF e ir movendo e deletando as pastas. Uso FindFirst, mas ele não entra em todas as pastas. Em alguma situação ele entra em loop sem fim.