Crestani

um amigo, do clube enviou para outro colega, eu preciso, tentei fazer, mas nao consigo, nao sei o que estou fazendo de errado. preciso que o word numere as cartas sempre automaticamente. mas ele diz que nao consegue abrir o arquivo; veja abaixo como ficou o código, nao sei onde estou errando. -------------------------------------------------- Sub Cartanumerada() On Error GoTo Erro Documents.Add Template:="cartas.dot" ' *** Diretórios e arquivos - Faça aqui as alterações necessárias *** DocDir$ = "?E:\ANGIERRYS\Doc's\Pag. ANGIERRYS.dot.docm" ' onde gravar os docs ArqIni$ = "?E:\ANGIERRYS\Doc's\Pag. ANGIERRYS.dot.docm" '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ás; 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$("00103" & n, 3) ' Texto a incluir. Ex: Carta001/98 AnoAtual$ = Right$(AnoAtual$, 2) NovoTexto$ = "Carta" + Valor$ + "/" + AnoAtual$ ' Escreve número no documento Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "Autonumeração" .Replacement.Text = NovoTexto$ .Forward = True .Wrap = wdFindContinue End With Selection.Find.Execute Replace:=wdReplaceAll ' Caminho e Nome do arquivo DOC com o número. Ex: Fax001-98.doc nomedoc$ = "E:\ANGIERRYS\Doc's\Pag. ANGIERRYS.dot.docm" + Valor$ + "000103.doc" + AnoAtual$ + ".doc" 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 ActiveDocument.SaveAs FileName:=nomedoc$ System.PrivateProfileString(ArqIni$, "Contador", "CartaNum") = Valor$ End If GoTo Fim Erro: MsgBox "Não foi possível abrir o Arquivo." 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 ----------------------------------------------------