Notifications
Clear all

Validar existência de arquivo

3 Posts
2 Usuários
0 Reactions
941 Visualizações
mdosmagos
(@mdosmagos)
Posts: 78
Trusted Member
Topic starter
 

Boa noite!

Não estou conseguindo validar a existência de um arquivo em um diretório, marquei no código onde preciso validar a existência do arquivo, preciso que se o arquivo não exista apareça uma mensagem avisando e pare o código, mas se ele existir continue o código sem mensagem.

Sub Clientes_Importar()

Dim confirmaenvio As String
confirmaenvio = MsgBox("Para importar você deve primeiro ter exportado o arquivo da planilha antiga, você já exportou o arquivo?", vbYesNo + vbQuestion, "E-mail")
If confirmaenvio = vbNo Then
End
Else
Cancel = True
End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Atual = ActiveWorkbook.Path & "" & ActiveWorkbook.Name
AtualJanela = ActiveWorkbook.Name
Importar = ActiveWorkbook.Path & "" & "IMPORTAR CLIENTES" & "" & "IMPORTARCLIENTESDK.xlsx"

PRECISO QUE VALIDE A EXISTÊNCIA DE IMPORTAR AQUI

Workbooks.Open Importar
Sheets("Clientes").Select
Cells.Select
Selection.Copy
Windows(AtualJanela).Activate
Sheets("Clientes").Select
Cells.Select
ActiveSheet.Paste
Range("A2").Select
Sheets("Definições").Select
Range("C5:O6").Select
Windows("IMPORTARCLIENTESDK.xlsx").Activate
Application.CutCopyMode = False
ActiveWindow.Close
Windows(AtualJanela).Activate
Sheets("Definições").Select
Range("C5:O6").Select

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Kill Importar

MsgBox "Importação dos clientes concluida com sucesso."

End Sub

Desde já agradeço a ajuda....

 
Postado : 13/04/2014 9:06 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Aproveitando a dica do colega Wagner Morel no tópico abaixo :
Set fs = Application.FileSearch
viewtopic.php?t=9319&p=48861

Conforme ele orientou :
Esse comando foi descontinuado a partir do Excel 2007. Voce pode utilizar o FSO para atender a sua necessidade. Deve, antes de utilizar o FSO, referenciar a biblioteca Microsoft Scripting Runtime no menu Referencias.

Primeiro Adicione a Function abaixo (os creditos estão no tópico acima) :

Function FileExists(FileName As String) As Boolean

    Dim fs As FileSystemObject
    Set fs = CreateObject("Scripting.filesystemobject")
    
    FileExists = fs.FileExists(FileName)

End Function

Depois troque seu codigo por este:

Sub Clientes_ImportarMauro()
    Dim confirmaenvio As String
    Dim Importar As String
    Dim vArq_Exist
    
    confirmaenvio = MsgBox("Para importar você deve primeiro ter exportado o arquivo da planilha antiga, você já exportou o arquivo?", _
                    vbYesNo + vbQuestion, "E-mail")

    If confirmaenvio = vbNo Then
        End
    Else
        Cancel = True
    End If

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Atual = ActiveWorkbook.Path & "" & ActiveWorkbook.Name
    AtualJanela = ActiveWorkbook.Name
    Importar = ActiveWorkbook.Path & "" & "IMPORTAR CLIENTES" & "" & "IMPORTARCLIENTESDK.xlsx"

    'PRECISO QUE VALIDE A EXISTÊNCIA DE IMPORTAR AQUI
    vArq_Exist = FileExists(Importar)
    
    If vArq_Exist = False Then
        MsgBox "O Arquivo IMPORTARCLIENTESDK.xlsx... NÃO existe !"
        Exit Sub
    End If

    Workbooks.Open Importar
    Sheets("Clientes").Select
    Cells.Select
    Selection.Copy
    Windows(AtualJanela).Activate
    Sheets("Clientes").Select
    Cells.Select
    ActiveSheet.Paste
    Range("A2").Select
    Sheets("Definições").Select
    Range("C5:O6").Select
    Windows("IMPORTARCLIENTESDK.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWindow.Close
    Windows(AtualJanela).Activate
    Sheets("Definições").Select
    Range("C5:O6").Select
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    Kill Importar
    
    MsgBox "Importação dos clientes concluida com sucesso."

End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 13/04/2014 10:03 pm
mdosmagos
(@mdosmagos)
Posts: 78
Trusted Member
Topic starter
 

Muito obrigado, era isso que eu precisava. :D

 
Postado : 14/04/2014 4:35 am