How to open a VBA website

Question

Hello, I found a code that enters a website and makes authentication. After that it is on the home page of the site. I wanted to put this code to enter another link, but without closing the Internet Explorer that is open and authenticated. First part of the code he enters the site and authenticates (I already have), second part he writes another link and is redirected, for example: https://stackoverflow.com/.

Follows the Code:

Sub Login()

Dim oHTML_Element As IHTMLElement
Dim sURL As String
Dim myURL As String
Dim URL As String
Dim objElement As Object
Dim IE As Object
Dim IEapp As Object
Dim enderecoDaUrl As String



On Error GoTo Err_Clear
   sURL = "https://clientes.tray.com.br/?redirect=redirected"
Set oBrowser = New InternetExplorer
   oBrowser.Silent = True
   oBrowser.timeout = 60
   oBrowser.navigate sURL
   oBrowser.Visible = True

Do
Loop Until oBrowser.readyState = READYSTATE_COMPLETE

Set HTMLDoc = oBrowser.document
    HTMLDoc.all.loja.Value = Range("D4").Value
    HTMLDoc.all.usuario.Value = Range("D2").Value
    HTMLDoc.all.senha.Value = Range("D3").Value

For Each oHTML_Element In HTMLDoc.getElementsByTagName("input")
    If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For

Next
Err_Clear:

Resume Next
Sleep (5000)

'AQUI IRIA A SEGUNDA PARTE'

End Sub

After going to this second part, when entering the link, is automatically downloaded a file .zip... You have some other code to open this zip file that has been downloaded into another excel sheet that I am working on?

Thank you!

Answer 1

Good morning,

I tested the code above and what happened was that, after the execution of the first part (which accesses and authenticates on the Tray website), opened a new tab in Internet Explorer without closing the Tray page (which, in my case, obviously did not authenticate, since I do not have the user and password values).

That is, the mentioned problem did not occur and I did not make any changes in the code. That was just what I needed to run?

As for unzipping and copying a Zip file, I believe the code below will help:

Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Dim WB  As Variant

'O código abaixo vai solicitar o caminho onde o arquivo zip se encontra.
    Fname = Application.GetOpenFilename(FileFilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=False)
    If Fname = False Then
        'Do nothing
    Else

        'Este código vai pegar a pasta root principal, pode ser substituído por outro caminho se preferir
        DefPath = Application.DefaultFilePath
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        'Este código definirá o nome da pasta a ser criado
        strDate = Format(Now, " dd-mm-yy h-mm-ss")
        FileNameFolder = DefPath & "MinhaPastaExtraida " & strDate & "\"
'O código abaixo irá criar o nome para a pasta onde irá colocar os arquivos extraídos
        MkDir FileNameFolder

        'Extrai o arquivo zip
        Set oApp = CreateObject("Shell.Application")
    'Cola os arquivos extraidos para pasta destino
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

    'Procura o arquivo a ser aberto
    WB = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", MultiSelect:=False)
    'Abre a planilha
    Workbooks.Open WB
    'Copia a aba da planilha extraída para a planilha em que você está trabalhando (substitua o nome "Pasta4.xlsm" abaixo pelo nome da sua planilha)
    ActiveWorkbook.ActiveSheet.Copy After:=Workbooks("Pasta4.xlsm").Sheets(Sheets.Count)
    'Volta para a primeira aba (substitua o nome "Planilha1" abaixo pelo nome da aba da planilha em que você está trabalhando)
    Set WB = Workbooks("Pasta4.xlsm")
    WB.Sheets("Planilha1").Select
    WB.Sheets("Planilha1").Range("A1").Select
    
        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    End If


End Sub

I hope it helps. Any problem, let me know!