PAulo Lopes

Ao chegar na linha " Word.ActiveDocument.SaveAs2 FileName:=nomedoc$ " da erro 5981 e não salva. poderiam me ajudar? Sub CertCal() On Error GoTo Erro ' Documents.Add Template:="CCA-01-CC-0.dotm" ' *** Diretórios e arquivos - Faça aqui as alterações necessárias *** DocDir$ = "\\Plus-fs\laboratorio\DOCUMENTOS ATUAIS\PSG\PSGP\CCA\" ' onde gravar os docs ArqIni$ = "\\Plus-fs\laboratorio\DOCUMENTOS ATUAIS\PSG\PSGP\CCA\CCA.Ini" 'onde armazenará o arquivo ini ' Lê o ano no relógio do PC AnoAtual$ = Year(Now()) ' Testa existência do Arquivo INI If ArquivoExiste(ArqIni$) <> -1 Then ' Não existe, cria INI Call ZeraContagem(AnoAtual$, ArqIni$) Else ' Existe, testa ano; atualiza INI AnoIni$ = System.PrivateProfileString$(ArqIni$, "Contador", "Ano") DIf = Val(AnoAtual$) - Val(AnoIni$) If DIf > 0 Then ' Ano novo Call ZeraContagem(AnoAtual$, ArqIni$) ElseIf DIf < 0 Then ' Ano andou para tr; pára macro MsgBox "Erro no relógio do micro ou arquivo INI adulterado." GoTo Fim End If End If ' Lê o número atual no arquivo INI nuMicrosoft = System.PrivateProfileString$(ArqIni$, "Contador", "CartaNum") n = Val(nuMicrosoft) + 1 ' soma 1 Valor$ = Right$("000" & n, 3) ' Texto a incluir. Ex: Carta001/98 ' AnoAtual$ = Right$(AnoAtual$, 2) NovoTexto$ = "CCA " + Valor$ + "/" + AnoAtual$ ' Escreve número no documento Word.Selection.Find.ClearFormatting Word.Selection.Find.Replacement.ClearFormatting With Word.Selection.Find .Text = "Autonumeracao" .Replacement.Text = NovoTexto$ .Forward = True .Wrap = wdFindContinue End With Word.Selection.Find.Execute Replace:=wdReplaceAll ' Caminho e Nome do arquivo DOC com o número. Ex: Fax001-98.doc nomedoc$ = DocDir$ + "CCA " + Valor$ + "-" + AnoAtual$ + ".docx" If ArquivoExiste(nomedoc$) = -1 Then MsgBox "O arquivo " + nomedoc$ + " já existe. Operação cancelada." Else ' Salva o arquivo e escreve o número no arquivo INI Word.ActiveDocument.SaveAs2 FileName:=nomedoc$ System.PrivateProfileString(ArqIni$, "Contador", "CartaNum") = Valor$ End If GoTo Fim Erro: MsgBox Err.Number Resume Next Fim: End Sub Function ArquivoExiste(Arq$) ' Testa se o arquivo Arq$ existe On Error GoTo ArqExiste_Err Open Arq$ For Input As #1 Close #1 ArquivoExiste = -1 'Existe GoTo FimArq ArqExiste_Err: ArquivoExiste = 0 'Não Existe FimArq: End Function Sub ZeraContagem(AnoNovo$, Ini$) ' Grava o ano atual, zera a contagem System.PrivateProfileString(Ini$, "Contador", "Ano") = AnoNovo$ System.PrivateProfileString(Ini$, "Contador", "CartaNum") = "0" End Sub