Access inicio | | | | | |
Olá,
Seja Bem Vindo ao Blog.

Conecte-se ou registre-se e utilize gratuitamente este equipamento, temos exemplos referente a criação de banco de dados e desenvolvimento de softwares e programas utilizando o Microsoft Access.


Administração do Blog AccessDoProgramador.

FSO - FileSystemObject para manipularmos arquivos no MS Access

Ver o tópico anterior Ver o tópico seguinte Ir em baixo

23012011

Mensagem 

FSO - FileSystemObject para manipularmos arquivos no MS Access






Autor: JPaulo  Fórum MaximoAccess

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



avatar
vieirasoft
Facilitador
Facilitador

Portugal


Voltar ao Topo Ir em baixo

- Tópicos similares
Compartilhar este artigo em: diggdeliciousredditstumbleuponslashdotyahoogooglelive

FSO - FileSystemObject para manipularmos arquivos no MS Access :: Comentários

Mensagem em Sex 3 Maio 2013 - 11:39 por smscrmc90

Bom dia,

Quero agradecer pelas dicas postadas nesta pagina pois e ajudou num grave problema que me foi imposto.
Muito obrigado a todos os que colaboram para com o forum.

Voltar ao Topo Ir em baixo

Mensagem em Sex 2 Maio 2014 - 13:45 por vperotto

Meu amigo, meus parabéns!
O tópico ficou excelente e me auxiliou muito!

Grande abraço e obrigado pelo apoio!

Voltar ao Topo Ir em baixo

Mensagem  por Conteúdo patrocinado

Voltar ao Topo Ir em baixo

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo


 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum