Pesquisar na Comunidade

Estou usando uma planilha Excel com macros programadas em vba. Preciso criar uma conexão SOAP para acessar um WSDL de um serviço de chamados, mas recebo erro ao tentar iniciar o objeto SOAP. "O componente ActiveX não pode criar objeto" Segue o código: Sub teste() Dim wsConn As New SoapClient30 Dim wsAuth As String 'Inicializa o SOAP acessando WSDL Set wsConn = New MSSOAPLib30.SoapClient30 wsConn.MSSoapInit "http://empresa.com.br/ws/services/Ticket/WSTicket.wsdl" 'Realiza o LOGIN wsAuth = wsConn.LOGIN(“conexão_ws”, “123”, “1”) End Sub O manual de integração da ferramenta orienta a fazer desta forma e está disponível aqui. O erro é acusado na linha Set wsConn = New MSSOAPLib30.SoapClient30 Estou usando na empresa um Windows 7 64bit recém instalado, Office 2016 (problema também acontece em Office 2013). O pc fica dentro de uma rede No meu pc pessoal o objeto é criado. Este tem Windows 10 e Office 2016 Já fiz instalação do pacote SoapToolkit30.exe. A importação acontece normalmente e foi o mesmo pacote que instalei no meu pc. A DLL está devidamente referenciada. Já procurei exaustivamente na internet pela solução desse problema e nada até agora resolveu.

Olá! Sou novo por aqui e preciso da ajuda de vocês. Estou criando uma planilha para uma igreja lançar seus dízimos e suas despesas. Criei um formulário de lançamentos e no código, há uma opção de pesquisar pelo número de lançamento e apagar aquele lançamento da pesquisa. O problema é que o código está apagando também o número de lançamento, que está na primeira coluna (A:A). Como fazer para apagar somente a partir do número de lançamento? Abaixo, o código que uso e um print do formulário com a planilha. Private Sub bt_excluir_Click() 'Declarar a variável Resp para receber uma resposta Dim Resp As Integer 'Fazer a busca do registro digitado pelo usuário With Worksheets("Saídas").Range("A:A") Set c = .Find(txt_lançamento.Value, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then Resp = MsgBox("Tem certeza que deseja excluir o registro?", vbYesNo, "Confirmação") If Resp = vbYes Then c.Select ActiveCell.Delete Selection.EntireRow.Delete 'Limpar as caixas de texto txt_data.Value = Empty txt_empresa.Value = Empty txt_cnpj.Value = Empty txt_nf.Value = Empty txt_documento.Value = Empty txt_discriminação.Value = Empty txt_banco.Value = Empty txt_valor.Value = Empty txt_juros.Value = Empty txt_data.SetFocus Else MsgBox "O registro não será excluído!" End If Else MsgBox "Registro não excluído" End If End With Exit Sub End Sub Aguardo pela ajuda de vocês.

Olá, estou criando um crawler em vba para manter atualizado certas informações que busco manualmente. Minha dúvida até que é simples. Estou fazendo o seguinte FOR: For Each i In IE.Document.body.getElementsByTagName("span") o i recebe o seguinte valor "[obejct HTMLSpanElement]" Até aqui beleza, mas como na página existe vários "spans" encontrei a dificuldade de identificar o qual preciso. Página: https://www.ferramentaskennedy.com.br/busca?q=Tcs72Xp16At Com o apoio do Chrome vejo o seguinte: No código: <span class="valor h6"> R$ 1.598,00 </span> Demais infos: span.valor.h6 innerText: "R$ 1.598,00" tentei fazer o FOR assim: For Each i In IE.Document.body.getElementsByTagName("span.valor.h6") Mas não localiza a informação e pula essa etapa. Tentei também: For Each i In IE.Document.body.getElementsByTagName("span").getAttributesByClassName("valor h6") Que gera o erro: Erro em tempo de execução '438' O objeto não aceita esta propriedade ou método Outra forma que tentei, também com o erro 438: For Each i In ie.Document.body.getElementsByTagName("span") For Each j In ie.Document.body.getElementsByClassName("valor h6") 'até aqui esta rodando vlr = ie.Document.body.getElementsByClassName("valor h6").innerText 'aqui gera o erro 438 Next j Next i Obs.: Não sou programador, apenas estou tentando agilizar o meu dia-a-dia. Já visitei alguns sites/foruns diferentes e não encontro a resposta, agradeço quem puder me ajudar.

Tenho um formulário que cadastra um contato de uma empresa com os seguintes campos: nome, cargo, telefone, email. Até ai ok, porém, quero fazer algo que funcione da seguinte forma: Vou preencher os campos do meu formulário: Empresa: Empresa Teste Nome: Fernando Cargo: Analista Telefone: 999999999 Email: teste@teste.com Após fazer o preenchimento vou clicar em um botão "Inserir registro" e ele deverá salvar na planilha, isso já está funcionando perfeitamente. A minha dúvida é a seguinte: Preciso inserir um ListBox abaixo desse meu formulário que após eu clicar no botão Inserir Registro irá carregar nele somente o que for referente a empresa "Empresa Teste" Exemplo: Empresa: Empresa Teste Nome: Fernando Cargo: Analista Telefone: 999999999 Email: teste@teste.com "Clico" no botão Inserir Registro ListBox Contatos cadastrados para cliente Fernando Nome Cargo Telefone Email Fernando Analista 999999999 teste@teste.com Joaquim Gerente 101010101 teste2@teste.com

Boa noite pessoal, preciso da ajuda de vocês pra algo que parece simples, mas por falta de prática não estou conseguindo fazer. Tenho um formulário que esta sendo alimentado pelo meu bd, quero filtrar ele quando marco um checkbox. Por exemplo, tem uma coluna no meu bd que chama "Premium", quero filtrar somente os clientes Premium quando marcar essa checkbox. Consegui um código que esta funcionando, porém, não atualiza o formulário deixando somente os clientes Premium visíveis. Private Sub FiltroPremium_AfterUpdate() If Me.FiltroPremium = -1 Then Me.Filter = "Premium = 'Sim'" Me.FilterOn = True Else Me.Filter = "" Me.FilterOn = False End If End Sub Desde já, muito obrigado.

Amigos, bom dia. Li atentamente os tópicos do forum mas não encontrei o que procurava. Se alguém tiver ideia, por favor, auxilie. PROBLEMA: No meu trabalho, há uma planilha que recebe atualizações em tempo real de dados de temperatura (é um link RTD. mas também existe o DDE). Ele coloca num célula do excel o último valor de temperatura que a CETESB informa. Tenho somente uma célula do excel que fica alternando esse valor a cada segundo. Gostaria de registrar esses valores a cada segundo e colocar num gráfico, registrar (minuto a minuto) o valor máximo, mínimo. Se puder ajudar, agradeço. Julio

Boa tarde, Estou precisando enviar um e-mail via excel através do VBA através de um e-mail fixo e dois alterados. Melhor explicando: o e-mail fixo, exemplo, teste@teste.com.br e na aba N47 e H47 o usuario coloca os e-mail que deverá ser enviadas também como copia. Estou utilizando ActiveWorkbook.SendMail, mas o e-mail fixo é perfeito, mas não estou conseguindo o comando para pegar os e-mail localizados na plan1 na célular N47 e H47 e enviar por e-mail a planilha.

Olá, estou usando um código VBA para pegar uma informação de uma página web. O código VBA segue os seguintes passos: 1. Abre uma página web (a página default mostra os dados para a data de ontem 11/04/2018) 2. Preenche o campo de data com o valor 09/04/20214 3. Clica no botão OK 4. Pega um valor da página que foi carregada depois do clique no botão OK O problema é que o valor retornado não é o valor que foi atualizado depois do clique do botão e sim o valor que já estava na página default. A página mostrada no IE está com o valor atualizado mas o retorno do código tem o valor antigo. O código é de novato e que adaptou a partir de buscas na internet. Obrigado pela ajuda. Dim IE As Object Dim objElement As Object Dim objColletion1 As Object Dim objColletion2 As Object Dim x As Object Dim y As Object Dim i As Long 'Create Internet Explorer object Set IE = CreateObject("InternetExplorer.Application") IE.Visible = True 'IE.navigate "http://www.bmfbovespa.com.br/pt_br/servicos/market-data/consultas/mercado-de-derivativos/contratos-em-aberto/por-tipo-de-participante/" IE.navigate "http://www2.bmf.com.br/pages/portal/bmfbovespa/lumis/lum-tipo-de-participante-ptBR.asp" sleep (5000) 'wait 5 seconds to load web page Set objColletion1 = IE.document.getelementsbytagname("input") 'set field in a object i = 0 While i < objColletion1.Length 'try to find out field named "dData1" If objColletion1(i).Name = "dData1" Then ' set the date objColletion1(i).Value = "09/04/2018" 'a date before today End If i = i + 1 Wend Set objColletion2 = IE.document.getelementsbytagname("button") 'set the buttons on page i = 0 While i < objColletion2.Length 'try to fid out the button to submit If objColletion2(i).Type = "submit" And objColletion2(i).Name = "" Then 'OK button found Set objElement = objColletion2(i) End If i = i + 1 Wend objElement.Click 'OK button clicked sleep (5000) 'wait to load web page For Each x In IE.document.body.getelementsbytagname("table") 'search for a expected value If InStr(x.innertext, "MERCADO FUTURO DE DÓLAR") > 0 Then For Each y In x.getelementsbytagname("tr") If InStr(y.innertext, "Inv. Não Residente") > 0 Then MsgBox y.getelementsbytagname("td")(1).innertext End If Next y End If Next x Set IE = Nothing Set objElement = Nothing Set objColletion1 = Nothing Set objColletion2 = Nothing Bruno.

Bom dia pessoal, sou novo na utilização do VBA e não sei legal a utilização do loop Fiz um código para copiar vária células (Planilha Maio (1)coluna B da linha 4 para baixo) e colar dentro de uma única com quebra de página(Planilha Maio Célula B7), só que eu quero que copia somente as células que tem conteúdo, fiz do Range B4:B10 de uma forma muito manual, queria aumentar esse range de uma forma automática, segue abaixo o que eu fiz: Sub () Sheets("Maio").Activate Range("B7").Select If Sheets("Maio (1)").Range("B10") <> "" Then ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _ & vbCrLf & Sheets("Maio (1)").Range("B6") & vbCrLf & Sheets("Maio (1)").Range("B7") _ & vbCrLf & Sheets("Maio (1)").Range("B8") & vbCrLf & Sheets("Maio (1)").Range("B9") _ & vbCrLf & Sheets("Maio (1)").Range("B10") ElseIf Sheets("Maio (1)").Range("B9") <> "" Then ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _ & vbCrLf & Sheets("Maio (1)").Range("B6") & vbCrLf & Sheets("Maio (1)").Range("B7") _ & vbCrLf & Sheets("Maio (1)").Range("B8") & vbCrLf & Sheets("Maio (1)").Range("B9") ElseIf Sheets("Maio (1)").Range("B8") <> "" Then ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _ & vbCrLf & Sheets("Maio (1)").Range("B6") & vbCrLf & Sheets("Maio (1)").Range("B7") _ & vbCrLf & Sheets("Maio (1)").Range("B8") ElseIf Sheets("Maio (1)").Range("B7") <> "" Then ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _ & vbCrLf & Sheets("Maio (1)").Range("B6") & vbCrLf & Sheets("Maio (1)").Range("B7") ElseIf Sheets("Maio (1)").Range("B6") <> "" Then ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _ & vbCrLf & Sheets("Maio (1)").Range("B6") ElseIf Sheets("Maio (1)").Range("B5") <> "" Then ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") ElseIf Sheets("Maio (1)").Range("B4") <> "" Then ActiveCell.Value = Sheets("Maio (1)").Range("B4") End If End Sub Se alguém puder ajudar agradeço.

Bom dia Não tenho conhecimento em VBA, mas elaborei uma macro a partir de soluções encontradas na WEB. Concluí a macro e ao executar utilizando a tecla F8, ela funciona perfeitamente, porém ao executar a macro de forma automática ela trava. A macro apenas abre um arquivo TXT, seleciona só as colunas necessárias, identifica a quantidade de linhas e copia os dados para outra planilha. Nesta planilha, os dados são copiados para a célula D1. Depois disso copia fórmulas que estão na Plan2 para a Plan1, nas células A2:C2. Ai finalmente copia estas fórmulas para a quantidade de linhas identificadas no TXT e finalmente transforma as fórmulas em texto. Não sei como posso enviar os arquivos, mas não tem nada de mais, então se alguém puder criar arquivos com os nomes inseridos na macro e testar não terá problemas Segue a macro Sub Novo() Dim Linha As Long ' Exclui as linhas preenchidas do Arq Teste a partir da linha A3. ' Isso tem o objetivo de manter a fórmula das células A2:c2 Windows("Arq teste.xltm").Activate Range("A3").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.EntireRow.Delete ' Selection.ClearContents Range("d2").Select 'Abre o arquivo texto selecionando apenas as colunas necessárias ChDir "C:\Users\User\Dropbox" Workbooks.OpenText Filename:="C:\Users\User\Dropbox\ABC_Vendas Dia.txt", _ Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 9), Array(6, 9), Array(7, 9), Array(8, 1), _ Array(9, 9), Array(10, 9), Array(11, 9), Array(12, 9), Array(13, 1), Array(14, 9), Array(15 _ , 9), Array(16, 9), Array(17, 1), Array(18, 9), Array(19, 9), Array(20, 9), Array(21, 9), _ Array(22, 9), Array(23, 9), Array(24, 9), Array(25, 9), Array(26, 9), Array(27, 9), Array( _ 28, 9), Array(29, 1), Array(30, 9), Array(31, 9), Array(32, 1), Array(33, 9), Array(34, 1), _ Array(35, 1), Array(36, 9), Array(37, 9), Array(38, 9), Array(39, 9), Array(40, 9), Array( _ 41, 9), Array(42, 9), Array(43, 9), Array(44, 9), Array(45, 9), Array(46, 9), Array(47, 9), _ Array(48, 9), Array(49, 9), Array(50, 9), Array(51, 9), Array(52, 9), Array(53, 9), Array( _ 54, 9), Array(55, 9), Array(56, 9), Array(57, 9)), TrailingMinusNumbers:=True 'Faz a contagem de linhas e vai para uma linha abaixo Windows("ABC_Vendas Dia.txt").Activate Range("A1").Select Linha = Range("C" & Rows.Count).End(xlUp).Row ' Seleciona os dados do arquivo TXT e copia Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Copy ' Seleciona o arquivo fim e cola os dados do TXT Windows("Arq teste.xltm").Activate Range("D1").Select ActiveSheet.Paste ' Sheets("Plan1").Select ' Range("A2").Select Sheets("Plan2").Select Range("A2:C2").Select Selection.Copy Sheets("Plan1").Select Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False ' Range("A2").Select Windows("ABC_Vendas Dia.txt").Activate ActiveWorkbook.Close Windows("Arq teste.xltm").Activate ' Marca as células que contém fórmulas e copia para as demais linhas da planilha Range("A2:C2").Select Application.CutCopyMode = False Selection.AutoFill Destination:=Range("A2:C" & Linha) Range("A2:C" & Linha).Select ' Range("A2:C2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A1").Select End Sub Alguém pode me ajudar

Olá pessoal, boa tarde! Tenho uma macro que atualiza um relatório de hora em hora e envia um e-mail no fim do Script para alguns usuários com o status naquele momento. Porém, toda vez que a macro está rodando, sempre quando chega no momento de criar uma imagem e colar, ele da um erro em tempo de execução 1004. Mas, quando abre o depurador, se eu dou um play pra seguir a macro, ele segue normalmente até o fim. E como roda de 1 em 1 hora, tenho que sempre estar olhando pra quando der o erro, clicar em depurar e dar play para seguir com a macro. Deixei uma parte em negrito no Script, que foi uma tentativa de resolver o problema, aguardando 30 segundos para colar a imagem. Mas não adiantou, o erro sempre ocorre. Segue abaixo o Script da macro e onde está sublinhado é quando ocorre o erro: Private Sub createJpg(Namesheet As String, nameRange As String, nameFile As String) ThisWorkbook.Activate Worksheets(Namesheet).Activate newHour = Hour(Now()) newMinute = Minute(Now()) newSecond = Second(Now()) + 30 waitTime = TimeSerial(newHour, newMinute, newSecond) Application.Wait waitTime Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange) ThisWorkbook.Worksheets(Namesheet).Range(nameRange).CopyPicture ----- Nessa parte é aonde da o erro. With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height) .Activate .Visible = True .Chart.Paste With .Chart.Shapes(1) .Width = Plage.Width .Height = Plage.Height End With .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG" .Visible = False End With ActiveSheet.Shapes(Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Name).Line.Visible = msoFalse Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete Set Plage = Nothing End Sub Caso precisem de mais alguma informação para poder me ajudar, estou à disposição. Valeu!

Fala pessoal em um text box do meu formulário quero que aceite apenas valores de data fiz dessa forma: If Not IsDate(Me.MP1_PG1_DtDevolBX.Value) Or Len(Me.MP1_PG1_DtDevolBX.Value) <> 10 Then MsgBox "Digite uma data de devolução de pasta válida no formato DD/MM/AAAA!", vbCritical Application.ScreenUpdating = True Exit Sub End If Até ae tudo bem, só que apenas a primeira condicional Not IsDate ele aceita valores de horário, por isso coloquei a segunda condicional para ter 10 caracteres (DD/MM/AAAA),só que ainda aceita valores como 14:52:0000. Tem alguma forma mais prática de aceitar só data em determinado formato como valor? Outra coisa, alguém sabe porque datas antes de 1800 dá um erro de definição de variável? :S

Olá! Sou novo por aqui e preciso da ajuda de vocês. Estou criando uma planilha para uma igreja lançar seus dízimos e suas despesas. Criei um formulário de lançamentos e no código, há uma opção de pesquisar pelo número de lançamento e apagar aquele lançamento da pesquisa. O problema é que o código está apagando também o número de lançamento, que está na primeira coluna (A:A). Como fazer para apagar somente a partir do número de lançamento? Abaixo, o código que uso e um print do formulário com a planilha. Private Sub bt_excluir_Click() 'Declarar a variável Resp para receber uma resposta Dim Resp As Integer 'Fazer a busca do registro digitado pelo usuário With Worksheets("Saídas").Range("A:A") Set c = .Find(txt_lançamento.Value, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then Resp = MsgBox("Tem certeza que deseja excluir o registro?", vbYesNo, "Confirmação") If Resp = vbYes Then c.Select ActiveCell.Delete Selection.EntireRow.Delete 'Limpar as caixas de texto txt_data.Value = Empty txt_empresa.Value = Empty txt_cnpj.Value = Empty txt_nf.Value = Empty txt_documento.Value = Empty txt_discriminação.Value = Empty txt_banco.Value = Empty txt_valor.Value = Empty txt_juros.Value = Empty txt_data.SetFocus Else MsgBox "O registro não será excluído!" End If Else MsgBox "Registro não excluído" End If End With Exit Sub End Sub Aguardo pela ajuda de vocês.

Bom dia! Gostaria de uma ajuda por favor, sobre um problema que já pesquisei bastante no Google mas não encontrei a resposta Estou criando uma macro para a empresa em que trabalho, cujo o objetivo é reunir em um local só links para diversos sistemas e programas. Alguns desses programas estão na rede, outros instalados no próprio computador do usuário. Para abrir estes programas instalados localmente, estou usando o seguinte código: Sub NomePrograma() Dim RetVal RetVal = Shell("C:\Sistemas\NomePrograma_Zero\NomePrograma.BAT", 1) End Sub Este comando deu certo porque o caminho do C:\ não contém espaços. Mas há outros diversos programas cujo o caminho é recheado de espaços. Como resolver este problema? Desde já agradeço pela atenção.

Olá pessoal, primeiro post aqui no forum, espero estar na sessão correta. Tenho interesse de construir um form que contenha uma TrackBar, como a da imagem abaixo. Há possibilidade de inseri-lo via VBA, Excel? Desde já, Obrigado!

Olá, estou usando um código VBA para pegar uma informação de uma página web. O código VBA segue os seguintes passos: 1. Abre uma página web (a página default mostra os dados para a data de ontem 11/04/2018) 2. Preenche o campo de data com o valor 09/04/20214 3. Clica no botão OK 4. Pega um valor da página que foi carregada depois do clique no botão OK O problema é que o valor retornado não é o valor que foi atualizado depois do clique do botão e sim o valor que já estava na página default. A página mostrada no IE está com o valor atualizado mas o retorno do código tem o valor antigo. O código é de novato e que adaptou a partir de buscas na internet. Obrigado pela ajuda. Dim IE As Object Dim objElement As Object Dim objColletion1 As Object Dim objColletion2 As Object Dim x As Object Dim y As Object Dim i As Long 'Create Internet Explorer object Set IE = CreateObject("InternetExplorer.Application") IE.Visible = True 'IE.navigate "http://www.bmfbovespa.com.br/pt_br/servicos/market-data/consultas/mercado-de-derivativos/contratos-em-aberto/por-tipo-de-participante/" IE.navigate "http://www2.bmf.com.br/pages/portal/bmfbovespa/lumis/lum-tipo-de-participante-ptBR.asp" sleep (5000) 'wait 5 seconds to load web page Set objColletion1 = IE.document.getelementsbytagname("input") 'set field in a object i = 0 While i < objColletion1.Length 'try to find out field named "dData1" If objColletion1(i).Name = "dData1" Then ' set the date objColletion1(i).Value = "09/04/2018" 'a date before today End If i = i + 1 Wend Set objColletion2 = IE.document.getelementsbytagname("button") 'set the buttons on page i = 0 While i < objColletion2.Length 'try to fid out the button to submit If objColletion2(i).Type = "submit" And objColletion2(i).Name = "" Then 'OK button found Set objElement = objColletion2(i) End If i = i + 1 Wend objElement.Click 'OK button clicked sleep (5000) 'wait to load web page For Each x In IE.document.body.getelementsbytagname("table") 'search for a expected value If InStr(x.innertext, "MERCADO FUTURO DE DÓLAR") > 0 Then For Each y In x.getelementsbytagname("tr") If InStr(y.innertext, "Inv. Não Residente") > 0 Then MsgBox y.getelementsbytagname("td")(1).innertext End If Next y End If Next x Set IE = Nothing Set objElement = Nothing Set objColletion1 = Nothing Set objColletion2 = Nothing Bruno.

Preciso linkar um arquivo xls com o Access e, para que ele atualize sozinho os dados do banco, preciso me livrar de um erro que está dando ao abrir o arquivo: The file and extension of 'nome_do_arquivo' don't match. The file could be corrupted or unsafe. Unless you trust its source, don't open it. Do you want to open it anyway?Quando dou "ok" ele abre normalmente e se eu salvar como, o novo arquivo não dá mais essa mensagem de erro. No entanto, não quero precisar abrir manualmente o arquivo e salva-lo todos os dias só para me livrar desse erro. Tenho que dar um tratamento para ele usando VBA e gostaria de me livrar dessa mensagem de erro via macro. Só não sei como fazer isso. Tentei várias maneiras de abrir o arquivo e várias maneiras de fechar salvando como. O novo arquivo salvo mantém essa mensagem, o que impede o Access de atualizar os dados ao tentar lê-lo.Meu código se encontra abaixo (deletei o que não interessava para tornar mais fácil a ajuda):Public Sub Busca()Dim sFile, dire As String'tirei o diretório propositalmente aqui para que vocês substituam pelo de vocêsdire = "K:\...\"sFile = Dir(dire & "arquivo1.xls")If sFile <> "" ThenSet wbTransf = Workbooks.OpenXML(dire & sFile)wbTransf.Close SaveChanges:=True, Filename:=dire & "arquivo2.xls"ElseMsgBox "GS Report não encontrado"End IfEnd Sub Não é possível anexar o arquivo corrompido aqui para facilitar a vida de vocês, mas testarei todas as soluções que me propuserem. Desde já, agradeço a ajuda.

Sou iniciante em vba, peguei vários recortes de códigos e está funcionando corretamente, mas queria fazer um upgrade, invés da macro salvar no diretório que foi selecionado através do caminho em uma célula do excel, gostaria que fosse aberta uma janela para o usuário escolher onde exportar o txt. Sub GravarArquivoTxt() Sheets("plan1").Select 'aqui está salvando em um diretório que está na planilha na célula B1, nessa parte queria que fosse aberta uma janela para selecionar um diretório. Open Range("B1").Value & "\" & Range("D1").Value & ".txt" For Output As 1 Cells(2, 1).Select While ActiveCell.Value <> "" Print #1, ActiveCell.Value Cells(ActiveCell.Row + 1, ActiveCell.Column).Select Wend MsgBox "Arquivo gerado com sucesso!", vbInformation, "Informação" Close 1 Exit Sub ErroAcesso: MsgBox "Erro ao acessar a pasta." & Chr(13) & "Verifique se ela existe e/ou se o endereço está correto.", vbCritical, "Atenção," End Sub

Boa tarde Pessoal!! Tenho uma base que recebo mensalmente com 79 colunas, mas só utilizo 10 colunas da mesma. Gostaria de criar uma macro que "limpasse" esta base para me trazer em uma outra pasta apenas as colunas que preciso. Seria legal eu definir as coluna com uma variável, pois cada coluna tem um um nome, e gostaria de atribuir a macro a um botão pois como a base é mensal seria bem mais fácil atribuir a um botão. Muito Obrigado e fico no aguardo!

Boa tarde Pessoal!! Tenho uma base que recebo mensalmente com 79 colunas, mas só utilizo 10 colunas da mesma. Gostaria de criar uma macro que "limpasse" esta base para me trazer em uma outra pasta apenas as colunas que preciso. Seria legal eu definir as coluna com uma variável, pois cada coluna tem um um nome, e gostaria de atribuir a macro a um botão pois como a base é mensal seria bem mais fácil atribuir a um botão. Muito Obrigado e fico no aguardo!

Olá, Usei muito o VBA, mas acabei parando... No entanto agora voltei a usar e estou com dificuldade em relembrar algumas estruturas. Mas basicamente eu estou com a seguinte demanda: Em uma planilha de uma pasta, para cada(na verdade um while) nome no endereço B2:B202 eu vou abrir um arquivo na pasta local; Nessa nova pasta de trabalho aberta, calcular na planilha1: MÉDIA(Planilha1!A169:A171;Planilha1!A183:A185)*(CONT.VALORES(Planilha1!A169:A185)-6); Devolver para primeira pasta de trabalho em uma segunda planilha uma linha para cada calculo Acho que é isso...

Bom dia, estou precisando salvar a planilha como pdf, dentro de uma pasta Mensal. No caso, se estiver em março quando utilizar o botao, quero que o excel salve em uma pasta C:\planilhas\impressao\marco\nome do arquivo , se estiver em abril C:\planilhas\impressao\abril\nome do arquivo . A minha idéia foi a seguinte: usar uma célula para fornecer o mês com =Hoje(), depois pegaro mês com =mês(), e depois jogar no macro VBA criando uma variável com o valor desta célula, e adicionando esta célula no caminho para salvar o pdf. O código está da seguinte forma: Sub IMPRIME_FOLHA_VERDE() ' Imprime resumo Dim imprime As String imprime = Range("AD1").Value & "\" 'AD1 É A CELULA QUE CONTEM O MÊS ChDir "C:\planilhas\Confidencial" 'Abaixo é o caminho da pasta, aonde deveria usar a célula para setar o mês Caminho = ThisWorkbook.Path & "\impressoes\pedidos\" & imprime 'Abaixo é a configuração para salvar em PDF e o restante do nome do arquivo, que está correto, pois tudo funciona normalmente quando não coloco a variavel imprime em Caminho. ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Caminho & [AA1].Value & "-" & [AB1].Value & "-" & [AC1].Value & "_" & "PEDIDO " & [Z1].Value & " - (" & [L11].Value & ")" & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, OpenAfterPublish:=True _ End Sub A questão é: Se eu setar a variável desta forma e colocar ela no caminho, o Excel está me retornando erro de depuração, se eu não usar a variável, tudo roda perfeitamente, porém eu só tenho o arquivo salvo em uma única pasta, sem separação mensal.

Boa tarde, Estou tentando fazer o download deste link "https://agentes.ons.org.br/download/operacao/hidrologia/arquivoMLTENAS_201709.pdf" Como a página é vazia e não tem desenvolvedor F12, eu tentei por SendKeys. Mas eu quando executo o código, a página abre e fecha mas não faz o download. Por que? E tem alguma outra forma de fazer este download? segue o código: Sub ENA_ONS() Dim ie As Object Set ie = CreateObject("InternetExplorer.Application") ie.Navigate "https://agentes.ons.org.br/download/operacao/hidrologia/arquivoMLTENAS_201709.pdf" ie.Visible = True Do Until (ie.readyState = 4 And Not ie.Busy) DoEvents Loop Application.SendKeys "%{S}" ie.Quit End Sub

Boa tarde, Estou tentando fazer o download deste link "https://agentes.ons.org.br/download/operacao/hidrologia/arquivoMLTENAS_201709.pdf" Como a página é vazia e não tem desenvolvedor F12, eu tentei por SendKeys. Mas eu quando executo o código, a página abre e fecha mas não faz o download. Por que? E tem alguma outra forma de fazer este download? segue o código: Sub ENA_ONS() Dim ie As Object Set ie = CreateObject("InternetExplorer.Application") ie.Navigate "https://agentes.ons.org.br/download/operacao/hidrologia/arquivoMLTENAS_201709.pdf" ie.Visible = True Do Until (ie.readyState = 4 And Not ie.Busy) DoEvents Loop Application.SendKeys "%{S}" ie.Quit End Sub

No rodapé deste site "http://sdro.ons.org.br/SDRO/DIARIO/index.htm" tem um ícone que faz o download de um arquivo .xls. Eu precisava clicar nele e salvar o arquivo, mas não sei como fazê-lo. Segue o código, adaptado de um outro fornecido pelo danieltakeshi, das duas formas que eu tentei fazer (a segunda marcada com *) nas duas a página abre e não acontece nada. Sub TesteBusca() Dim IE As Object Dim sWindows As Object Dim sJanelas As Object Dim sDados As String Dim doc As MSHTML.HTMLDocument Set IE = CreateObject("InternetExplorer.Application") IE.navigate "http://sdro.ons.org.br/SDRO/DIARIO/index.htm" IE.Visible = True EsperaIE IE, 2000 'Debug.Print IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a").innerText i = 1 For Each link In IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a") 'Debug.Print EXTRAIRELEMENTO(link.href, 8, "/") If EXTRAIRELEMENTO(link.href, 7, "/") = "DIARIO_18-03-2018.xlsx" Then i = i + 1 link.Click EsperaIE IE, 2000 If i = 2 Then Exit For End If Next link * i = 1 * For Each link In IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a") * If link.getAttribute("scr") = "../img/exportxls.gif" Then * i = i + 1 * link.Click * EsperaIE IE, 2000 * If i = 2 Then Exit For * End If *Next link End Sub Public Sub EsperaIE(IE As Object, Optional time As Long = 250) 'Código de: https://stackoverflow.com/questions/33808000/run-time-error-91-object-variable-or-with-block-variable-not-set Dim i As Long Do Sleep time Debug.Print CStr(i) & vbTab & "Ready: " & CStr(IE.READYSTATE = 4) & _ vbCrLf & vbTab & "Busy: " & CStr(IE.Busy) i = i + 1 Loop Until IE.READYSTATE = 4 Or Not IE.Busy End Sub Function EXTRAIRELEMENTO(Txt As String, n, Separator As String) As String On Error GoTo ErrHandler: EXTRAIRELEMENTO = Split(Application.Trim(Mid(Txt, 1)), Separator)(n - 1) Exit Function ErrHandler: ' error handling code MsgBox "Erro, veriique os dados de entrada." EXTRAIRELEMENTO = CVErr(xlErrNA) On Error GoTo 0 End Function