Skip to main content
Bumped by Community user
formatação e tag
Fonte Link
bfavaretto
  • 66,2mil
  • 11
  • 151
  • 228
Cod        Imagem
ao0001 ->  ao0001_1.jpg
           ao0001_2.jpg
           ao0001_3.jpg
Cod        Imagem
ao0001 ->  ao0001_1.jpg
           ao0001_2.jpg
           ao0001_3.jpg
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
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
    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
    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
Cod        Imagem
ao0001 ->  ao0001_1.jpg
           ao0001_2.jpg
           ao0001_3.jpg
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
    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
Cod        Imagem
ao0001 ->  ao0001_1.jpg
           ao0001_2.jpg
           ao0001_3.jpg
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
    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
Correção ortográfica e formatação.
Fonte Link

Opa, TenhoTenho uma tabela com coluna IDas seguintes colunas ID, CodCod e NomeNome, tenho uma pasta com centenas de imagens, essas imagens estão com o inicio do nome igual a coluna CodCod da tabela, ou seja:

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

Função Procura_ArquivosProcura_Arquivos:

Ele traz a variavel RenameArquivovariável RenameArquivo e traz o Nomenome do arquivo, masporem, não renomeia.

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

Opa, Tenho uma tabela com coluna 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:

Preciso renomear todas as imagens para ficar igual a coluna Name. Tentei fazer:

Função Procura_Arquivos:

Ele traz a variavel RenameArquivo e traz o Nome do arquivo, mas, não renomeia.

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

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:

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

Função Procura_Arquivos:

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?

Fonte Link
sNniffer
  • 1mil
  • 2
  • 19
  • 45

Renomear vários arquivos com dados do Banco VB6

Opa, Tenho uma tabela com coluna 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:

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 variavel RenameArquivo e traz o Nome do arquivo, mas, não renomeia.

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