[Resolvido]Modificar nome de um arquivo txt

Amigos Mestres bom dia!

Gostaria de saber se é possível ao importar um determinado arquivo, modificar o seu nome.

Exemplo:

txtCartoes ao modificar ficaria txtCartoes_old

Eu utilizo a seguinte rotina para visualizar e exportar as informações, o que está faltando é somente modificar o nome.


Private Sub cmdImportar_Click()
On Error Resume Next
Dim Caminho As String, StrCaminho As String
Dim Titulo As String, filtro As String
filtro = "Arquivos de Retorno (*.txy)" & Chr(0) & "*.txt" & Chr(0)
Titulo = "Selecione o arquivo Mastercard"

Caminho = CurrentProject.Path
Caminho = LocalizarArquivo(Caminho, Titulo, filtro)
StrCaminho = Caminho
StrArquivo = Mid(Caminho, InStrRev(Caminho, "\") + 1)


Call ImportaTxt(StrCaminho)
End Sub


E em um módulo.

Option Compare Database
Option Explicit

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Function LocalizarArquivo(strDirIni As String, strTitulo As String, strFiltro As String)
Dim OpenFile As OPENFILENAME
Dim lReturn As Long, Pos As Integer
On Error Resume Next
OpenFile.lStructSize = Len(OpenFile)
OpenFile.lpstrFilter = strFiltro
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = strDirIni
OpenFile.lpstrTitle = strTitulo
OpenFile.Flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
LocalizarArquivo = ""
Else
Pos = InStr(1, OpenFile.lpstrFile, Chr(0))
LocalizarArquivo = Left(OpenFile.lpstrFile, Pos - 1)
End If
End Function

Olá, experimente:

Código:

Name CurrentProject.Path & "\txtCartoes" As CurrentProject.Path & "\txtCartoes_old"

Abraço

Olá Teixeira,

Farei o teste e lhe retorno.

Obrigado!!

Prezado Teixeira,

Não funcionou...
Pode me indicar onde insiro essa linha de código?

Olá, ja testou fazer apenas o rename de um ficheiro?
estou no phone, em casa vou verificar.
Abraço

Ok. Obrigado!

Fico no aguardo.

Olá, faltou colocar o código da função ImportaTxt
que podemos verificar nesta instrução:

Código:

Call ImportaTxt(StrCaminho)

Na minha opinião deverá ser efetuado no fim desta função após processar a importação.
Abraço

Teixeira bom dia!

A importação do arquivo está sendo feita normalmente, a chamada da função já foi declarada no código que postei.

O que preciso é que após a importação dos dados, o txt que forneceu dados para a tabela do access tenha o seu nome modificado. Evitando assim, que o usuário clique novamente nesse mesmo txt.

Olá,estou no Phone, mas na minha analise ao código deve ser no final da referida função.
Quando acaba o código da importação e foi efetuado o Close do ficheiro TXT.
Se colocares na linha a seguir ao Call, corres o risco de dar erro ou não processar a importação.
Cso pretendas fazer desta última forma, tenta o DoEvents antes do comando name.
Caso não consigas posta a função Importartxt
Abraço

Segui sua orientação mas ainda não deu certo.

segue o código solicitado.
A única observação é que cada arquivo txt que é importado possue um nome diferente. Para cada exportação efetuada, será necessário modificar o nome do arquivo, indicando ao usuário que já houve a exportação.

O que puder me ajudar eu agradeço.

Código:

Function ImportaTxt(Caminho As String)

Dim rs As DAO.Recordset
Dim fnum As Integer
Dim LinhaDoTexto As String
Dim ArquivoTexto As String
Dim nCount As Long
Dim nLinha As Integer
Dim StrSQL As String
Dim CaminhoCopia As String
Dim ContaLinha As Long


Dim DATA_TRANSACAO As Variant
Dim DATA_LIQ_FIN As Variant

Dim BRADESCO11102 As Variant
Dim BRADESCO11603 As Variant
Dim BRADESCO4380 As Variant
Dim BRADESCO6175 As Variant

Dim BRADESCARD5144 As Variant
'Dim BRADESCARD13757 As Variant
Dim BRADESCARD14075 As Variant

Dim BB4348 As Variant
Dim BB6145 As Variant
Dim BB13454 As Variant
Dim BB13804 As Variant

Dim SANTANDER8328 As Variant
Dim SANTANDER11783 As Variant

Dim CEF4476 As Variant
Dim CEF6492 As Variant

Dim ITAUBB4373 As Variant
Dim ITAUBB6282 As Variant
Dim ITAUBB9970 As Variant
Dim ITAUBB9992 As Variant
Dim ITAUBB12848 As Variant
Dim ITAUBB13755 As Variant

StrSQL = "SELECT * FROM TMastercard"

Set rs = CurrentDb.OpenRecordset(StrSQL)

ArquivoTexto = Caminho

fnum = FreeFile

Open ArquivoTexto For Input As fnum

   Do While Not EOF(fnum)
       nLinha = nLinha + 1
       Line Input #fnum, LinhaDoTexto
       
       If InStr(LinhaDoTexto, "SETTLEMENT DATE:") > 0 Then
          DATA_TRANSACAO = fncModificaData(LTrim(RTrim(Mid(LinhaDoTexto, 29, 11))))
       
       End If
       
           If InStr(LinhaDoTexto, "VALUE DATE:") > 0 Then
               DATA_LIQ_FIN = fncModificaData(LTrim(RTrim(Mid(LinhaDoTexto, 29, 11))))
           End If
       
'==============================================================================
'                          **********        BRADESCO
'==============================================================================
       
Dim B1, B2, B3, B4 As Integer

       
           If InStr(LinhaDoTexto, 11102) > 0 Then
               B1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = B1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BRADESCO11102 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
           
           If InStr(LinhaDoTexto, 11603) > 0 Then
               B2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = B2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BRADESCO11603 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
           
           If InStr(LinhaDoTexto, 4380) > 0 Then
               B3 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = B3 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BRADESCO4380 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
           If InStr(LinhaDoTexto, 6175) > 0 Then
               B4 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = B4 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BRADESCO6175 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
           
'==============================================================================
'                          **********        Itaú Unibanco
'==============================================================================

Dim I1, I2, I3, I4, I5, I6 As Variant


           If InStr(LinhaDoTexto, 4373) > 0 Then
               I1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               ITAUBB4373 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
           If InStr(LinhaDoTexto, 6282) > 0 Then
               I2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               ITAUBB6282 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               

           If InStr(LinhaDoTexto, 9970) > 0 Then
               I3 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I3 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               ITAUBB9970 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
           If InStr(LinhaDoTexto, 9992) > 0 Then
               I4 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I4 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               ITAUBB9992 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
     
           If InStr(LinhaDoTexto, 12848) > 0 Then
               I5 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I5 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               ITAUBB12848 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If

           If InStr(LinhaDoTexto, 13755) > 0 Then
               I6 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I6 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               ITAUBB13755 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
'==============================================================================
'                          **********        BANCO DO BRASIL, S.A
'==============================================================================

Dim BB1, BB2, BB3, BB4 As Variant

           If InStr(LinhaDoTexto, 4348) > 0 Then
               BB1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BB1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BB4348 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
           If InStr(LinhaDoTexto, 6145) > 0 Then
               BB2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BB2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BB6145 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
           If InStr(LinhaDoTexto, 13454) > 0 Then
               BB3 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BB3 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BB13454 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
           If InStr(LinhaDoTexto, 13804) > 0 Then
               BB4 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BB4 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BB13804 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
               
'==============================================================================
'                          **********        BANCO BRADESCARD S.A
'==============================================================================
               
 Dim BR1, BR2, BR3 As Variant
               
            If InStr(LinhaDoTexto, 5144) > 0 Then
               BR1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BR1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BRADESCARD5144 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
           'If InStr(LinhaDoTexto, 13757) > 0 Then
           '    BR2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           'End If
           '    If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BR2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
           '    BRADESCARD13757 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
           '    End If
               
           If InStr(LinhaDoTexto, 14075) > 0 Then
               BR3 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BR3 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               BRADESCARD14075 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
'==============================================================================
'                          **********        CAIXA ECONOMICA FEDE
'==============================================================================
               
 Dim CEF1, CEF2 As Variant
               
            If InStr(LinhaDoTexto, 4476) > 0 Then
               CEF1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = CEF1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               CEF4476 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
           If InStr(LinhaDoTexto, 6492) > 0 Then
               CEF2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = CEF2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               CEF6492 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
'==============================================================================
'                          **********        BANCO SANTANDER (BRA
'==============================================================================
               
 Dim BS1, BS2 As Variant
               
            If InStr(LinhaDoTexto, 8328) > 0 Then
               BS1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BS1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               SANTANDER8328 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If
               
           If InStr(LinhaDoTexto, 11783) > 0 Then
               BS2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
           End If
               If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BS2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
               SANTANDER11783 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
               End If

   Loop
   

   rs.AddNew
   
   rs(1) = DATA_TRANSACAO
   rs(2) = DATA_LIQ_FIN
   rs(3) = BRADESCO11102
   rs(4) = BRADESCO11603
   rs(5) = BRADESCO4380
   rs(6) = BRADESCO6175
   
   rs(7) = BRADESCARD5144
   'rs(8) = BRADESCARD13757
   rs(9) = BRADESCARD14075
   
   rs(10) = BB4348
   rs(11) = BB6145
   rs(12) = BB13454
   rs(13) = BB13804
   
   rs(14) = SANTANDER8328
   rs(15) = SANTANDER11783
   
   rs(16) = CEF4476
   rs(17) = CEF6492
   
   rs(18) = ITAUBB4373
   rs(19) = ITAUBB6282
   rs(20) = ITAUBB9970
   rs(21) = ITAUBB9992
   rs(22) = ITAUBB12848
   rs(23) = ITAUBB13755
       
           
   rs.Update
   

MsgBox "Dados importados com sucesso.!"


End Function

Olá, acho que deve ficar assim:

Código:

   rs(21) = ITAUBB9992
   rs(22) = ITAUBB12848
   rs(23) = ITAUBB13755
      
          
   rs.Update
  
  rs.Close
  Set rs = Nothing
  Close fnum

   Name Caminho As "Importado_" & Caminho

MsgBox "Dados importados com sucesso.!"


End Function


Acho que o erro que te dava era devido ao ficheiro estar aberto. Repara no que foi incluído no código além do name
Abraço

Prezado Teixeira,

Infelizmente não ocorre alteração no nome do arquivo.

Olá,

1) Deu algum erro?
2) Já experimentou apenas o codigo "name..." separadamente sem ser no seu projeto e se funciona?

Fico aguardar.

Abraço

Teixeira boa tarde!

1) Não
2) Sim. Mas não funciona.

é interessante que não dá erro mas tambem nao acontece nada no arquivo que estou importando.

Realmente estou precisando muito solucionar essa minha dúvida.

Estou agradecido por todo interesse que tens em me ajudar.

Olá, espero que não seja problem a de permissoes.
Outra forma de fazer o mesmo (que eu não preferia) é fazer o name logo de inicio, sendo a importação efetuada já com o nome de ficheiro renomeado.

Código:

Private Sub cmdImportar_Click()
On Error Resume Next
Dim Caminho As String, StrCaminho As String
Dim Titulo As String, filtro As String
filtro = "Arquivos de Retorno (*.txt)" & Chr(0) & "*.txt" & Chr(0)
Titulo = "Selecione o arquivo Mastercard"

Caminho = CurrentProject.Path
Caminho = LocalizarArquivo(Caminho, Titulo, filtro)
StrCaminho = Caminho
StrArquivo = Mid(Caminho, InStrRev(Caminho, "\") + 1)

Name StrCaminho As StrCaminho & "_old"
Call ImportaTxt(StrCaminho & "_old")

End Sub

No entanto efetuei um teste o qual anexo.
Abraço

Prezado Teixeira,

Inseri em meu código e está modificando o nome, porém ao inserir _old a extensão do arquivo é modificada.

Fiz uma "gambiarra" = improviso, fazendo com que a linha name fique da seguinte forma:

Código:

Name strCaminho As strCaminho & "_old.txt"

No entanto o arquivo fica parecido com esse exemplo:

13485-TCA-LA00098610-2014-09-18.txt_old.txt_old.txt

Você sabe como arrumar esse problema?

Desde já agradecido muito por toda a sua ajuda.

Olá, sem o código é dificil, no entanto experimente

Onde está:

     Call ImportaTxt(StrCaminho & "_old")

alterar por:

     Call ImportaTxt(StrCaminho)

Se não der, será melhor postar o código.

Abraço

Deu certo!

Muito obrigado!!!

resolvido

Olá Lebersa12, obrigado pelo retorno, o forúm agradece.

Eu quem agradeço Teixeira.

Que Deus o abençoe!!