Verificar se a Workbook escolhida já esta aberta

2024 - VBA & Macros

Post Recente por adrigja 7 anos atrás

4 Posts

3 Usuários

0 Reactions

773 Visualizações

RSS

adrigja

(@adrigja)

Posts: 2

New Member

Topic starter

Estou montando uma planilha que coleta o conteúdo de 3 abas de uma Workbook selecionada pelo usuário.
Porém se a planilha escolhida já estiver aberta, aparece uma mensagem do windows informado que o documento já está aberto e perguntado se deseja reabrir.
Caso o usuário clique em Sim, a macro funciona perfeitamente. Porém se o usuário clicar em Não a mesma para de funcionar e apresenta Erro 1004.

Tentei algumas sugestões em outros tópicos semelhantes utilizando a ferramenta de busca mas não consegui resolver isso.
Alguém teria alguma ideia de como solucionar isso?.

Desde já agradeço a atenção

Segue o código, e planilhas para testes em anexo.
Microsoft Excel 2010

Sub importar()


Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Copy As Worksheet

Set wb1 = ActiveWorkbook
Set Copy = ActiveWorkbook.Sheets("Cross Excel")

MsgBox "Selecione o Excel de Itens do Dia", vbOKOnly, "Seleção de Arquivo"

FileToOpen = Application.GetOpenFilename _
(Title:="Procurar", _
FileFilter:="Report Files *.xlsx (*.xlsx),")

If FileToOpen = False Then
    MsgBox "Seleção incorreta", vbExclamation, "Erro"
    Exit Sub
    

Else

    Set wb2 = Workbooks.Open(Filename:=FileToOpen) 'Essa linha ocorre falha a caso o Workbook já estiver aberto conforme relatado.
   
    If wb2.Sheets(1).Name = "CAT A" Then
      
        wb2.Sheets(1).Select
        Range("A4:j4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy Destination:=Copy.Range("a1")
        
        Application.CutCopyMode = False


Dim LR As Long 'retorna o numero da ultima linha com conteudo da coluna

LR = wb1.Sheets("Cross Excel").Cells(Rows.Count, 1).End(xlUp).Row

        wb2.Sheets(2).Select
        Range("A5:j5").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy Destination:=Copy.Range("A" & LR + 1)
        
        Application.CutCopyMode = False

Dim LS As Long 'retorna o numero da ultima linha com conteudo da coluna

LS = wb1.Sheets("Cross Excel").Cells(Rows.Count, 1).End(xlUp).Row

        wb2.Sheets(3).Select
        Range("A5:j5").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy Destination:=Copy.Range("A" & LS + 1)

        Application.CutCopyMode = False


   Else
            MsgBox "Arquivo incorreto", vbExclamation, "Erro"
            wb2.Close savechanges:=False
         Exit Sub
     End If

End If

    wb2.Close savechanges:=False


End Sub

Postado : 24/02/2018 12:05 am

klarc28

(@klarc28)

Posts: 971

Prominent Member

If Not IsFileOpen(FileToOpen) Then

Set wb2 = Workbooks.Open(Filename:=FileToOpen)

Else

Workbooks(Filename:=FileToOpen).Close SaveChanges:=False
Set wb2 = Workbooks.Open(Filename:=FileToOpen)

End If

Postado : 24/02/2018 8:52 am

EdsonBR

(@edsonbr)

Posts: 1057

Noble Member

Sub importar()
...
...
  If FileToOpen = False Then
      MsgBox "Seleção incorreta", vbExclamation, "Erro"
      Exit Sub
  Else
'************* Início alterações
    On Error Resume Next
      Set wb2 = Workbooks(Right(FileToOpen, InStr(1, StrReverse(FileToOpen), _
                          "", vbTextCompare) - 1))
      If Err.Number = 9 Then
        Err.Clear
        Set wb2 = Workbooks.Open(Filename:=FileToOpen) 'Essa linha ocorre falha caso o Workbook já estiver aberto.
        If Err.Number <> 0 Then
          MsgBox "Ocorreu um erro:", vbCritical, "ERRO"
          Exit Sub
        End If
      End If
    On Error GoTo 0
    If wb2.Sheets(1).Name = "CAT A" Then
        wb2.Sheets(1).Activate  '>>>TROQUE .Select POR .Activate
'************* Final alteraçoes
        Range("A4:j4").Select
...
...
End Sub