Ao tentar salvar como um documento retorna erro 5981

[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