Calcular Frete nos Correios – Tabela de Prazo de Entrega e Valores – Planilha Excel VBA

Resolver problema no filtro em tabelas dinâmicas Excel
Resolver problema no filtro em tabelas dinâmicas Excel
20 de setembro de 2012
Criando log no Excel VBA - Nome do usuário VBA, Data e hora VBA
Criando log no Excel VBA – Nome do usuário VBA, Data e hora VBA
29 de setembro de 2012

Calcular Frete nos Correios – Tabela de Prazo de Entrega e Valores – Planilha Excel VBA

Objetivo da Planilha: Calcular frete nos correios. Planilha em Excel VBA calculador de frete correios que realiza a pesquisa ao XML para determinar preços e prazos correios, conforme o serviço, origem, destino e dimensões dos pacotes. Realiza esta tarefa para todos os pacotes de uma só vez. Veja o novo Rastreamento correio no excel.

Calcular Frete nos Correios

Esta Tabela Frete Correios Excel foi ideia foi enviada pelo amigo marcospaf através do Fórum do Guia do Excel, e achei que poderia ser útil para a nossa comunidade.

Com base na ideia, resolvi criar a planilha de frete dos correios, que serve para ajudar a calcular o prazo de entrega e orçar frete. Ela contém uma tabela com calculador de preços e prazos das entregas, de acordo com serviço, peso e dimensões, tipo de serviços de entrega (Pac, Sedex, Sedex 10, Sedex 12, mundi) para que você possa escolher o melhor resultado. 

 A planilha funciona da seguinte forma, são digitados os campos:

  1. CEP Origem: CEP de onde será despachado o pacote;
  2. CEP Destino: CEP do destino para o qual será enviada a encomenda;
  3. Serviço: Tipo do serviço disponibilizado pelos correios, conforme lista passada pelo próprio correio;
  4. Peso: Peso do pacote;
  5. Comprimento: Comprimento do pacote;
  6. Largura: Largura do pacote;
  7. Altura: Altura do pacote.

Abaixo o código VBA que monta a planilha automaticamente:

Sub lsConsultaProdutoCorreios()

    Application.ScreenUpdating = False

    Dim lUltimaLinhaAtiva As Long

    Worksheets("Rastreamentos").Select

    lUltimaLinhaAtiva = Worksheets("Lista de encomendas").Cells(Worksheets("Lista de encomendas").Rows.Count, 1).End(xlUp).Row + 1

    For i = 6 To lUltimaLinhaAtiva
        
        DoEvents
        
        With ActiveWorkbook.Connections("Conexão23")
            .Name = "Conexão23"
            .Description = ""
        End With
        Range("A1:C200").Select
        With Selection.QueryTable
            .Connection = _
            "URL;http://ws.correios.com.br/calculador/CalcPrecoPrazo.aspx?nCdEmpresa=&sDsSenha=&nCdServico=" & Worksheets("Lista de Encomendas").Range("D" & i).Value & "&sCepOrigem=" & Worksheets("Lista de Encomendas").Range("A" & i).Value & "&sCepDestino=" & Worksheets("Lista de Encomendas").Range("B" & i).Value & "&nVlPeso= " & Worksheets("Lista de Encomendas").Range("E" & i).Value & "&nCdFormato=1&nVlComprimento=" & Worksheets("Lista de Encomendas").Range("F" & i).Value & "&nVlAltura=" & Worksheets("Lista de Encomendas").Range("H" & i).Value & "&nVlLargura=" & Worksheets("Lista de Encomendas").Range("G" & i).Value & "&nVlDiametro=0&sCdMaoPropria=N&nVlValorDeclarado=0&sCdAvisoRecebimento=N&StrRetorno=xml"
            .WebSelectionType = xlAllTables
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        
        ActiveWorkbook.Connections("Conexão23").Refresh
        
        Worksheets("Lista de Encomendas").Range("I" & i).Value = Worksheets("Rastreamentos").Range("K3").Value
        Worksheets("Lista de Encomendas").Range("J" & i).Value = Worksheets("Rastreamentos").Range("N3").Value
    Next i
    
    Worksheets("Lista de encomendas").Select
    
    Application.ScreenUpdating = True
    
End Sub

 

Abraço

Marcos Rieper

 

____________

 

Links Úteis: Correios http://www.correios.com.br

48 Comments

  1. Raphael disse:

    Olá, primeiramente gostaria de agradecer pelos excelentes trabalhos postados. Tenho uma dúvida em relação à esta planilha. Não utilizei este código VBA, apenas baixei o arquivo e tudo funcionou perfeitamente, com exceção do rastreamento. Informa o seguinte erro:

    99Input

    Como poderei resolver este problema?

  2. joelma disse:

    oi eu gostei muito da planilha, mas eu tenho contrato com os correios, e essa opção esta dando erro.

    • Marcos Rieper disse:

      Bom dia Joelma,

      Tinha que ver como é o seu link para eu identificar o que pode estar ocorrendo, provavelmente como você deve estar logada no site ele deve estar indicando um outro site para a busca da informação.

      Abraço

      Marcos Reper

  3. marco aurelio disse:

    Boa Noite!!

    Está de parabéns irmão,muito boa essa planilha!!
    Na opção de serviço dos correios,e difícil incluir a opção para carta registrada??

  4. Danilo disse:

    Olá,

    Utilizo essa planilha para fazer cotações nos correios, mas essa semana a planilha parou de funcionar. Acredito que seja alguma alteração no site dos correios. Alguma novidade a respeito?

  5. Jordane disse:

    Uso a planilha mas verifiquei que a mesma parou de funcionar, a coluna prazo de entrega está sendo preenchido com o valor do frete e a coluna valor está vazia, poderia verificar. Muito obrigado.

  6. Jordane disse:

    Acabei de baixar a planilha que esta no link desta página e testar e a mesma está com o problema citado anteriormente será que os correios modificaram novamente o serviço, poderia verificar e corrigir se possível. Muito obrigado.

  7. Jordane disse:

    Testei e funcionou perfeitamente. Muito obrigado.

  8. Diogo disse:

    Olá,

    Gostaria de saber para que serve as linhas:

    With ActiveWorkbook.Connections(“Conexão23”)
    .Name = “Conexão23”
    .Description = “”
    End With

    e o refresh logo depois da consulta…

    Obrigado

  9. Roger disse:

    parou de funcionar, esta gerando erro nesta linha
    Worksheets(“Lista de Encomendas”).Range(“I” & i).Value = Worksheets(“Rastreamentos”).Range(“K3″).Value
    Worksheets(“Lista de Encomendas”).Range(“J” & i).Value = Worksheets(“Rastreamentos”).Range(“N3″).Value

  10. edimar85 disse:

    Tem um erro na aba de rastramento mostra o seguinte e assim por diante sabe me dizer o que é

  11. Daniel Pini disse:

    Bom dia é uma ótima planilha mas estou tentando verificar o frete para contrato e não me retorna nenhum valor.

  12. Diego disse:

    Olá Marcos,
    Excelente planilha, mas acho que estou com o mesmo problema do Daniel. Quando seleciono o serviço SEDEX com contrato (40096) o Prazo de Entrega e Valor retornam zerados. Testei usando os dados que vieram de exemplos na planilha e não calcula também.
    cep origem:5011970
    cep destino:89207900
    serviço: SEDEX com contrato
    Peso: 3
    comprimento: 20
    largura: 30
    altura: 10

    retornam resultados zerados

  13. Ulisses disse:

    Marcos, Bom dia.

    A planilha esta funcionando atualmente ? tentei rodar mas não consegui.

    Estou rodando dentro de uma planilha Excel.

    muito Obrigado

    Ulisses

  14. Diego disse:

    Pois então, realmente! ontem a planilha estava demorando em torno de 1 minuto pra calcular um item ou travava.
    Marcos, como saber que o link mudou ou está com algum problema?
    Outra dúvida,
    Nós usamos ela com o CEP origem sempre sendo o mesmo, tem como ao clicar pra calcular, preencher automaticamente o CEP ORIGEM com o nosso CEP, sem a necessidade de digitar? só informamos o CEP DESTINO.

  15. Gustavo disse:

    Marcos Rieper boa tarde, em excel para mac o que é pac e sedex (sedex sem contrato funciona) funciona, o restante das opcs retorna 0

  16. VINICIUS CRECENZI disse:

    Marcos, boa noite. Fiz o download hoje 05/05/2017 e quando clico em calcular, o retorno que se tem é 12:00:00 AM. Houveram algumas modificações oficiais nos métodos de consulta dos Correios. Será que é isso ?

  17. Danilo disse:

    Olá.

    Nao estou conseguindo baixar a planilha. Ela ainda funciona? Obrigado!

  18. Marcelo disse:

    Olá

    O calculo de preço e prazo esta retornando apenas uma data

  19. NATIALA disse:

    Olá, poderia me informar se ainda existe alguma planilha disponível que possa estar consultando o preço e prazo dos correios ?
    Desde já agradeço !

Deixe uma resposta

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *

Esse site utiliza o Akismet para reduzir spam. Aprenda como seus dados de comentários são processados.

Inscreva-se no nosso canal do Youtube!


Junte-se ao nosso canal do Youtube. Começamos em abril de 2016, mas já temos mais de 06:00 h de treinamentos gratuitos e este número irá aumentar. Vídeos novos todos os sábados.