Wesley Oliveira
não registrado
|
|
ENUNCIADA !
|
|
|
Postada em 28/03/2008 12:13 hs
Caros colegas sou novo em vba criei um sistema que gera um arquivo .doc do word, ele esta funcionando perfeitamente, o problema é o seguinte.
qundo crio um arquivo ele funfa perfeitamente, agora quando crio dois arquivo ele da este erro: "A máquina do servidor remoto não existe ou não está disponível" aí tenho que fechar o word e criar navamente. como resolvo este problema?
|
|
|
|
Treze
|
SÃO VICENTE SP - BRASIL
|
|
ENUNCIADA !
|
|
|
Postada em 28/03/2008 12:16 hs
posta pra gente o trecho do código que você criou fica mais fácil
|
|
|
Wesley Oliveira
não registrado
|
|
ENUNCIADA !
|
|
|
Postada em 28/03/2008 13:24 hs
Segue um trecho do código: Function CreateDoc() Dim WordObj As Word.Application Dim WordDoc As Word.Document Dim WordRng As Word.Range Dim WordPar As Word.Paragraph Set WordObj = CreateObject("Word.Application") With WordObj .Visible = True .WindowState = wdWindowStateMaximize .Documents.Add Set WordDoc = WordObj.ActiveDocument Set WordRng = WordDoc.Range With WordRng .Font.Name = "Monotype Corsiva" .Font.Color = wdColorRed .Font.Bold = True .Font.Italic = True .Font.Size = 48 .InsertAfter "Primeiro texto aqui" ' primeiro .InsertParagraphAfter ' segundo .InsertParagraphAfter ' tereceiro .InsertParagraphAfter ' quarto End With Set WordPar = WordRng.Paragraphs(4) With WordPar.Range '.Select .Font.Color = wdColorGreen .Font.Name = "Arial" .Bold = False .Italic = True .Font.Underline = wdUnderlineWavyDouble .Font.Size = 25 .InsertAfter "Documento Criado por Ivan Luiz Coelho em: " .Collapse Direction:=wdCollapseEnd .InsertDateTime DateTimeFormat:="DD-MMMM-YYYY HH:MM:SS" End With If MsgBox("Deseja alterar o texto", vbExclamation + vbYesNo) = vbYes Then WordRng.Paragraphs(4).Range.Delete ' apaga o paragrafo a ser modificado WordRng.Paragraphs(3).Range.InsertParagraph ' insere um novo paragrafo (anteriormente excluido) Set WordPar = WordRng.Paragraphs(4) ' seta o paragrafo para edição; With WordPar.Range .Font.Color = wdColorBlue .Font.Name = "Arial" .Bold = False .Italic = True .Font.Underline = wdUnderlineWavyDouble .Font.Size = 25 .InsertAfter "Documento alterado por Fulano de Tal em: " .Collapse Direction:=wdCollapseEnd .InsertDateTime DateTimeFormat:="DD-MMMM-YYYY HH:MM:SS" End With End If .ActiveDocument.SaveAs "C:AutCreateDate.Doc" ' Tire o comentário da linha abaixo para fechar o Word. '.Quit End With End Function
|
|
|
Treze
|
SÃO VICENTE SP - BRASIL
|
|
ENUNCIADA !
|
|
|
Postada em 28/03/2008 15:04 hs
Tenta o seguinte feche os objetos no final da função Set WordObj= Nothing Set WordDoc= Nothing Set WordRng= Nothing Set WordPar= Nothing
|
TÓPICO EDITADO
|
|
|
|
Inaldo Melo
não registrado
|
|
Postada em 03/09/2018 17:02 hs
Este código está dando o mesmo erro... Meu Window é o 10 e meu Office é o 365 Obrigado pela atenção!
Sub CNPJ2() 'On Error GoTo ErroTrat
Dim objIE As InternetExplorer <--- Aqui, também!!!
Dim elem Dim tbl Dim tr
Set objIE = CreateObject("InternetExplorer.Application")
With objIE .StatusBar = True .Toolbar = False .Width = 800 .Height = 600 .Resizable = True .AddressBar = False .Visible = True .Top = 60 .Left = 560 .Navigate "http://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/cnpjreva/Cnpjreva_Solicitacao2.asp" Do While .Busy Or _ .ReadyState <> 4 DoEvents Loop .Document.all.Item("cnpj").innertext = Forms!frmObterCadCNPJ.txtCNPJInf
reset: .Document.getElementById("txtTexto_captcha_serpro_gov_br").Focus <--- Primeiro aqui
x = .Document.activeElement.Name <--- Depois, aqui
Do While x = "txtTexto_captcha_serpro_gov_br" If objIE.ReadyState = READYSTATE_UNINITIALIZED Then Exit Sub
x = .Document.activeElement.Name DoEvents Loop
If .Document.all.Item("txtTexto_captcha_serpro_gov_br").Value = "" Then GoTo reset
.Document.all("submit1").Click
Do While .Busy Or _ .ReadyState <> 4 DoEvents Loop
For Each tr In .Document.getElementsByTagName("tr") If tr.innertext = "Erro na Consulta - Esclarecimentos adicionais. " Then GoTo reset Next
If objIE.ReadyState = READYSTATE_UNINITIALIZED Then Exit Sub 'Aguarda até a página ser carregada totalmente---- Do While objIE.LocationURL <> "http://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/cnpjreva/Cnpjreva_Comprovante.asp" Loop If objIE.LocationURL = "http://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/cnpjreva/Cnpjreva_Comprovante.asp" Then Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE: Loop End If For Each elem In .Document.all If elem.tagname = "TABLE" Then Set tbl = elem If tbl.Rows.Length >= 1 Then Set tr = tbl.Rows(0) If tr.Cells.Length >= 1 Then If Not InStr(tbl.Rows(0).innertext, "REPÚBLICA FEDERATIVA DO BRASIL") > 0 Then If InStr(tr.Cells(0).innertext, "NÚMERO DE INSCRIÇÃO") > 0 Then vCNPJ = Right(Left(tbl.Rows(0).Cells(0).innertext, 43), 19) 'Data Abertura vDtABert = Left(Right(tbl.Rows(0).Cells(2).innertext, 12), 10) End If 'Razão Social If InStr(tr.Cells(0).innertext, "NOME EMPRESARIAL") > 0 Then 'MsgBox InStr(tr.Cells(0).innertext, "NOME EMPRESARIAL") vRS = Trim(Trim(Right(tbl.Rows(0).Cells(0).innertext, Len(tbl.Rows(0).Cells(0).innertext) - Len(Left(tbl.Rows(0).Cells(0).innertext, 21))))) End If 'Nome Fatasia If InStr(tr.Cells(0).innertext, "TÍTULO DO ESTABELECIMENTO (NOME DE FANTASIA)") > 0 Then vFantasia = Trim(Trim(Right(tbl.Rows(0).Cells(0).innertext, Len(tbl.Rows(0).Cells(0).innertext) - Len(Left(tbl.Rows(0).Cells(0).innertext, 50))))) End If 'Atividade Economica If InStr(tr.Cells(0).innertext, "ATIVIDADE ECONÔMICA PRINCIPAL") > 0 Then 'MsgBox InStr(tr.Cells(0).innertext, "ATIVIDADE ECONÔMICA PRINCIPAL") vAtPrinc = Trim(Trim(Right(tbl.Rows(0).Cells(0).innertext, Len(tbl.Rows(0).Cells(0).innertext) - Len(Left(tbl.Rows(0).Cells(0).innertext, 57))))) End If 'Endereço If InStr(tr.Cells(0).innertext, "LOGRADOURO") > 0 Then vEndereco = Trim(Trim(Right(tbl.Rows(0).Cells(0).innertext, Len(tbl.Rows(0).Cells(0).innertext) - Len(Left(tbl.Rows(0).Cells(0).innertext, 16))))) 'Número vNum = Trim(Trim(Right(tbl.Rows(0).Cells(2).innertext, Len(tbl.Rows(0).Cells(2).innertext) - Len(Left(tbl.Rows(0).Cells(2).innertext, 11))))) 'Complemento vComp = Trim(Trim(Right(tbl.Rows(0).Cells(4).innertext, Len(tbl.Rows(0).Cells(4).innertext) - Len(Left(tbl.Rows(0).Cells(4).innertext, 16))))) End If If InStr(tr.Cells(0).innertext, "CEP") > 0 Then vCEP = Trim(Trim(Right(tbl.Rows(0).Cells(0).innertext, Len(tbl.Rows(0).Cells(0).innertext) - Len(Left(tbl.Rows(0).Cells(0).innertext, 9))))) 'Bairro vBairro = Trim(Trim(Right(tbl.Rows(0).Cells(2).innertext, Len(tbl.Rows(0).Cells(2).innertext) - Len(Left(tbl.Rows(0).Cells(2).innertext, 20))))) 'Cidade ou Município vMunicipio = Trim(Trim(Right(tbl.Rows(0).Cells(4).innertext, Len(tbl.Rows(0).Cells(4).innertext) - Len(Left(tbl.Rows(0).Cells(4).innertext, 14))))) 'Estado vUF = Trim(Right(tbl.Rows(0).Cells(6).innertext, 4)) End If End If End If End If End If Next
End With objIE.Quit Set objIE = Nothing
ErroTrat: If Err.Number = -2147467259 Then Exit Sub 'Trata erro caso a página seja fechada sem o término da execução do código If Err.Number = -2147417848 Then Exit Sub 'Trata erro caso a página seja fechada sem o término da execução do código If Err.Number = 0 Then Exit Sub 'Trata erro caso a página seja fechada sem o término da execução do código MsgBox "Erro Número: " & Err.Number & "." & vbCrLf _ & "Descrição: " & Err.Description & "." & vbCrLf _ & "Informe ao administrador do sistema.", vbCritical, "ERRO" objIE.Quit
Exit Sub
End Sub
|
|
|
|