2

Tenho uma tabela com as seguintes colunas ID, Cod e Nome, tenho uma pasta com centenas de imagens, essas imagens estão com o inicio do nome igual a coluna Cod da tabela, ou seja:

Cod        Imagem
ao0001 ->  ao0001_1.jpg
           ao0001_2.jpg
           ao0001_3.jpg

Preciso renomear todas as imagens para ficar igual a coluna Name, tentei fazer da seguinte forma:

Dim RenameArquivo As String

Set PrS = New ADODB.Recordset
SQL = "Select * From produto"
PrS.Open SQL, gConexao, adOpenStatic, adLockOptimistic, adCmdText

With PrS     

        RenameArquivo = Procura_Arquivo("c:\imagens\", PrS.Fields("cod") & "*")
        produto.Text = "c:\imagens\" & PrS.Fields("nome") & ".jpg"
        produto.Text = Replace(produto.Text, " ", "-")

           Dim FileName As String
           Dim NewFileName As String
           On Error Resume Next

           FileName = RenameArquivo
           NewFileName = produto.Text
           Name FileName As NewFileName

End With

Função Procura_Arquivos:

    Public Function Procura_Arquivo(Caminho As String, NomeArquivo As String) As String
    Dim lNullPos As Long
    Dim lResultado As Long
    Dim sBuffer As String

    On Error GoTo Procura_Arquivo_Error

    'Aloca espaco para a string sBuffer
    sBuffer = Space(MAX_PATH * 2)
    'inicia busca do arquivo
    lResultado = SearchTreeForFile(Caminho, NomeArquivo, sBuffer)

    ' Se houver um caracter Nulo , remove
    If lResultado Then
       lNullPos = InStr(sBuffer, vbNullChar)
        If Not lNullPos Then
           sBuffer = Left(sBuffer, lNullPos - 1)
        End If
       'Retorna o nome do arquivo encontrado
        Procura_Arquivo = sBuffer

    Else
        'nao achou nada
        Procura_Arquivo = vbNullString
    End If

    Exit Function
    Procura_Arquivo_Error:
        Procura_Arquivo = vbNullString
    End Function

Ele traz a variável RenameArquivo e traz o nome do arquivo, porem, não renomeia.

O que há de errado? É possível fazer isso em um Loop?

1
  • Deve estar ocorrendo um erro. Pode remover o On Error Resume Next e testar novamente?
    – bfavaretto
    Commented 22/01/2016 às 15:48

1 Resposta 1

0

Faria mais simples, primeiro verificaria se o arquivo existe e então executava o comando para renomear.

if Dir("c:\Temp\0001_1.jpg", vbArchive) <> "" then
    Name "c:\Temp\0001_1.jpg" As "c:\Temp\novonome.jpg"
End if

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .