Rename multiple files with VB6 Database data

Asked

Viewed 123 times

2

I have a table with the following columns ID, Cod and Nome, I have a folder with hundreds of images, these images are with the beginning of the name equal to column Cod table, that is to say:

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

I need to rename all images to look like the column Name, I tried to do it this way:

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

Function 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

It brings the variable RenameArquivo and bears the name of the file, but does not rename.

What’s wrong? It’s possible to do this in a Loop?

  • There must be an error. You can remove the On Error Resume Next and test again?

1 answer

0

Make it simpler, first check if the file exists and then run the command to rename.

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

Browser other questions tagged

You are not signed in. Login or sign up in order to post.