MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


    FSO - FileSystemObject para manipularmos arquivos

    JPaulo
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10591
    Registrado : 04/11/2009

    FSO - FileSystemObject para manipularmos arquivos Empty FSO - FileSystemObject para manipularmos arquivos

    Mensagem  JPaulo em 4/10/2010, 12:35

    FSO - FileSystemObject para manipularmos arquivos;

    O Objeto FSO comporta varios métodos para manipulação através do VBA, eis alguns:


    'Habilite a Referencia VBA Microsoft Scripting Runtime

    'Verifica se o ficheiro existe:

    Sub VerificaSeFicheiroExiste()
    Dim fso
    Dim file As String
    file = "C:\Teste.xls" ' caminho do ficheiro
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(file) Then
    MsgBox file & " não encontrado.", vbInformation, "Não Encontrado"
    Else
    MsgBox file & " encontrado.", vbInformation, "Encontrado"
    End If
    End Sub



    'Copiar um arquivo se ele existir:

    Sub CopiaFicheiro()
    Dim fso
    Dim file As String, sfol As String, dfol As String
    file = "teste.xls" ' nome do ficheiro
    sfol = "C:" ' caminho inicial
    dfol = "E:" ' caminho destino
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(sfol & file) Then
    MsgBox sfol & file & " não existe!", vbExclamation, "Erro"
    ElseIf Not fso.FileExists(dfol & file) Then
    fso.CopyFile (sfol & file), dfol, True
    Else
    MsgBox dfol & file & " existente!", vbExclamation, "Sucesso"
    End If
    End Sub



    'Mover um arquivo se ele existir:

    Sub MoverFicheiro()
    Dim fso
    Dim file As String, sfol As String, dfol As String
    file = "teste.xls" ' nome do ficheiro
    sfol = "C:" ' caminho inicial
    dfol = "E:" ' caminho destino
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(sfol & file) Then
    MsgBox sfol & file & " não existet!", vbExclamation, "Erro"
    ElseIf Not fso.FileExists(dfol & file) Then
    fso.MoveFile (sfol & file), dfol
    Else
    MsgBox dfol & file & " existente!", vbExclamation, "Sucesso"
    End If
    End Sub



    'Apagar um arquivo se ele existir:


    Sub ApagarFicheiro()
    Dim fso
    Dim file As String
    file = "C:\teste.xls" ' caminho do ficheiro
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(file) Then
    fso.DeleteFile file, True
    Else
    MsgBox file & " não existe ou foi apagado!" _
    , vbExclamation, "Erro"
    End If
    End Sub



    'Verifique se existe uma pasta:

    Sub VerificaSePastaExiste()
    Dim fso
    Dim folder As String
    folder = "C:\SuaPasta" ' caminho da pasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(folder) Then
    MsgBox folder & " pasta encontrada.", vbInformation, "Sucesso"
    Else
    MsgBox folder & " pasta não encontrada.", vbInformation, "Erro"
    End If
    End Sub



    'Crie uma pasta se não existir:

    Sub CriaPastaSeNaoExistir()
    Dim fso
    Dim fol As String
    fol = "c:\SuaPasta" ' caminho da pasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(fol) Then
    fso.CreateFolder (fol)
    Else
    MsgBox fol & " existente!", vbExclamation, "Sucesso"
    End If
    End Sub


    'Copiar uma pasta, se ela existe:

    Sub CopiaPastaExistente()
    Dim fso
    Dim sfol As String, dfol As String
    sfol = "c:\SuaPasta" ' caminho de origem da pasta
    dfol = "e:\SuaPasta" ' caminho de destino da pasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(dfol) Then
    fso.CopyFolder sfol, dfol
    Else
    MsgBox dfol & " existente!", vbExclamation, "Sucesso"
    End If
    End Sub



    'Mover uma pasta, se ela existe:

    Sub MoverPastaExistente()
    Dim fso
    Dim fol As String, dest As String
    sfol = "c:\SuaPasta" ' caminho de origem da pasta
    dfol = "e:\SuaPasta" ' caminho de destino da pasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(dfol) Then
    fso.MoveFolder sfol, dfol
    Else
    MsgBox dfol & " existente!", vbExclamation, "Sucesso"
    End If
    End Sub



    'Apagar uma pasta, se ela existe:

    Sub ApagarPastaExistente()
    Dim fso
    Dim fol As String
    fol = "c:\SuaPasta" ' caminho da pasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(fol) Then
    fso.DeleteFolder fol
    Else
    MsgBox fol & " não existe ou foi apagada!" _
    , vbExclamation, "Erro"
    End If
    End Sub



    'Mover todos os ficheiros de uma pasta para outra pasta:

    Sub MoverTodosOsFicheiros()
    Dim fso
    Dim sfol As String, dfol As String
    sfol = "c:\SuaPasta" ' caminho de origem da pasta
    dfol = "e:\SuaPasta" ' caminho de destino da pasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    If Not fso.FolderExists(sfol) Then
    MsgBox sfol & " caminho invalido.", vbInformation, "Erro"
    ElseIf Not fso.FolderExists(dfol) Then
    MsgBox dfol & " caminho invalido.", vbInformation, "Erro"
    Else
    fso.MoveFile (sfol & "\*.*"), dfol ' Alterar "\ *.*" para "\ *. xls" para mover só arquivos Excel
    End If
    If Err.Number = 53 Then MsgBox "não encontrado."
    End Sub



    'Copiar todos os ficheiros de uma pasta para outra pasta:


    Sub CopiaTodosOsFicheiros()
    Dim fso
    Dim sfol As String, dfol As String
    sfol = "c:\SuaPasta" ' caminho de origem da pasta
    dfol = "e:\SuaPasta" ' caminho de destino da pasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    If Not fso.FolderExists(sfol) Then
    MsgBox sfol & " caminho invalido.", vbInformation, "Erro"
    ElseIf Not fso.FolderExists(dfol) Then
    MsgBox dfol & " caminho invalido.", vbInformation, "Erro"
    Else
    fso.CopyFile (sfol & "\*.*"), dfol ' Alterar "\ *.*" para "\ *. xls" para mover só arquivos Excel
    End If
    If Err.Number = 53 Then MsgBox "não encontrado."
    End Sub





    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    FSO - FileSystemObject para manipularmos arquivos Folder_announce_new Utilize o Sistema de Busca do Fórum...
    FSO - FileSystemObject para manipularmos arquivos Folder_announce_new 102 Códigos VBA Gratuitos...
    FSO - FileSystemObject para manipularmos arquivos Folder_announce_new Instruções SQL como utilizar...
    FabioPaes
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3913
    Registrado : 14/08/2013

    FSO - FileSystemObject para manipularmos arquivos Empty Re: FSO - FileSystemObject para manipularmos arquivos

    Mensagem  FabioPaes em 8/4/2016, 22:55

    Parabéns JPaulo, Excelente Post com Excelentes Dicas!
    FabioPaes
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3913
    Registrado : 14/08/2013

    FSO - FileSystemObject para manipularmos arquivos Empty Copiar Vários Arquivos (Loop)

    Mensagem  FabioPaes em 4/1/2017, 19:21

    Como necessida de um membro do Fórum, segue uma forma de copiar Varios arquivos...

    Situação:

    Existe a Tabela "tbArquivo" com o Campo "NomeArquivo" que terá os nomes dos arquivos a serem copiados, ex:

    Planilha.xls
    Documento1.doc
    Teste.txt


    Dessa Forma, no click de um Botão, eirei percorrer todos os registros dessa tabela, e copiar seus arquivos para uma pasta.

    Código:
    Private Sub btCopiarArquivos_Click()
    Dim DB As Database
    Dim rs As DAO.Recordset
    Dim fso
    Dim file As String, sfol As String, dfol As String
    Set DB = CurrentDb()
    Set rs = DB.OpenRecordset("tbArquivo")

    Do While Not rs.EOF
    file = rs!NomeArquivo 'Nome do Campo com o Nome dos Arquivos
    'Pasta Origem dos arquivos
    sfol = CurrentProject.Path & "\"
    'Pasta destino para os arquivos
    dfol = CurrentProject.Path & "\1\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(sfol & file) Then
    MsgBox sfol & file & " não existe!", vbExclamation, "Erro"
    ElseIf Not fso.FileExists(dfol & file) Then
    fso.CopyFile (sfol & file), dfol, True
    Else
    MsgBox sfol & file & " existente!", vbExclamation, "Sucesso"
    Exit Sub
    End If
    rs.MoveNext
    Loop
    Set rs = Nothing
    Set DB = Nothing
    MsgBox "Copia terminada", vbInformation
    End Sub


    .................................................................................
    _____________________________________________________________________
    Achou a solução para sua dúvida? Não seja Egoísta, Compartilhe com todos!
    A dica do Colega foi útil? Agradeça!

    O importante não saber tudo, mas sim a Onde procurar!

    Conteúdo patrocinado

    FSO - FileSystemObject para manipularmos arquivos Empty Re: FSO - FileSystemObject para manipularmos arquivos

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 16/12/2019, 09:46