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....
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
Muito obrigado, era isso que eu precisava.