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
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