Enviar, exportar, criar documento word via vba

Boas pessoal,

Estou a três dias bolando um jeito de tentar exportar o conteúdo de tabelas para um novo arquivo do word.
Achei tópicos interessantes, infelizmente muitos aos quais não eram o que procurava ou não se adaptavam a minha questão

O problema é que tenho que criar um arquivo baseado em dados de um formulário continuo então a utilização de indicadores não ira me servir,
Segue anexo o banco de dados com exemplos de indicadores e criação de arquivo.

Caso alguém puder me dar uma dica para resolução agradeço.

ToWord.rar

E ai galera?

Alguém, alguma luz para minha duvida?

Se puderem pelo menos me explicar o motivo deste código não funcionar corretamente:

Dim appWord As Word.Application
Dim doc As Word.Document
Dim prg As Word.Paragraph
Dim rng As Word.Range

Me gera, Erro de compilação:
'sub ou 'function' não definida

para funcionar substitui os argumentos após As por Object, mas acho que por
este motivo não consigo adicionar um segundo paragrafo no código.

Segue código

Código:

   Private Sub btnEnviar_Click()
  
    Declarações Originais
    Dim appWord As Word.Application
    Dim doc As Word.Document
    Dim prg As Word.Paragraph
    Dim rng As Word.Range
  
    
    'A Aplicação é criada aqui:
    Set appWord = CreateObject("Word.Application")
    'A linha abaixo é importante: você deve querer que
    'sua aplicação seja visível na maioria das vezes
    appWord.Visible = True
    
    'Note que, na linha abaixo, foi adicionado um Documento
    'dentro da Aplicação appWord:
    Set doc = appWord.Documents.Add
    
    'Da mesma forma, é atribuído um Parágrafo prg o primeiro
    'parágrafo existente do Documento doc.
    Set prg = doc.Paragraphs(1)
    
    'Escrever algum texto no Documento...
    prg.Range.Text = "Este é o texto do primeiro paragrafo"
        
    'Por último, definimos que rng é um determinado intervalo de texto
    'do parágrafo prg:
    
    MsgBox "Orçamento criado com sucesso"
    
    'O método SaveAs2 é semelhante ao comando 'Salvar Como':
    doc.SaveAs2 FileName:="C:\Users\Beta XD\Desktop\Banco de Dados\Testes para inclusão\Orcamentos\Doc1", FileFormat:=wdFormatXMLDocument
    'FileFormat:=wdFormatXMLDocument significa que o arquivo será salvo com a
    'extensão .docx, ou seja, Documento do Word 2007-2010.
    
    'Agora, deseja-se sair da Aplicação. Observe que o método é executado
    'no nível da Aplicação, finalizando a Aplicação e todos os objetos
    'criados por ela:
    appWord.Quit
    
    'Apenas para limpar memória
    Set rng = Nothing
    Set prg = Nothing
    Set doc = Nothing
    Set appWord = Nothing
    
End Sub

UP!!!

Ainda tentando resolver mas não achei solução.

UP!!

Então, ainda não obtive respostas neste tópico, realmente não é tão limitado o que se encontra na net sobre criação de .doc-vba, mas acho que minha duvida já faz parte da limitação.
Bom a fim de saber se conseguiria o que gostaria de outro método utilizei comandos para criar um .txt segue:

Código:

Private Sub btnSendWord_Click()

    Dim iArq As Long            'Este é o texto a ser escrito
    Dim cns As Recordset        'Esta é a consulta a ser localizada
    Dim Servico As String       'Este é um campo da consulta localizada
    Dim Descricao As String     'Este é um campo da consulta localizada
    Dim Preco As String         'Este é um campo da consulta localizada
    Dim ServPreco As String     'Este é um campo da consulta localizada
    Dim Garantia As String      'Este é um campo da consulta localizada
    Dim DirName As String       'Este é o nome da pasta a ser criado


'CRIA A PASTA DO CLIENTE
DirName = CurrentProject.Path & "\Orçamentos\" & ConvertAccent(Me.Orcado)

If Dir(DirName, vbDirectory) = "" Then
MkDir DirName

Else
Exit Sub
End If
 
'CRIA O ARQUIVO
    iArq = FreeFile
    Open CurrentProject.Path & "\Orçamentos\" & ConvertAccent(Me.Orcado) & "\Orçamento -" & " " & Day(Date) & " " & MonthName(Month(Date)) & " " & (Year(Date)) & ".txt" For Output As iArq
    
        
'ESCREVE O SEGUINTE:
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    
    'SERVIÇOS E DESCRIÇÃO
        Set cns = CurrentDb.OpenRecordset("cnsToWord")
            Do While Not cns.EOF
            If cns("IdOrdem") = Me.IdOrdem And cns("Add") = True Then
            Servico = ""
            Servico = Servico & cns("Servico")
            Descricao = ""
            Descricao = Descricao & cns("Descricao")
        Print #iArq, Servico; ": "; Descricao
        Print #iArq, "CAMPOS"
            cns.MoveNext
        End If
        Loop
    
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    
    'PREÇOS
        Set cns = CurrentDb.OpenRecordset("cnsToWord")
            Do While Not cns.EOF
            If cns("IdOrdem") = Me.IdOrdem And cns("Add") = True Then
            Servico = ""
            Servico = Servico & cns("Servico")
            Preco = ""
            Preco = Preco & cns("Preco")
            Preco = Format(Preco, Right(String(15, "_"), 15) & "R$ #,####,####.00")
            ServPreco = ""
            ServPreco = ServPreco & Left(Servico & String(40, "_"), 40)
            ServPreco = ServPreco & Right(String(15, "_") & Preco, 15)
                        
            
            
        Print #iArq, ServPreco
            cns.MoveNext
        End If
        Loop

    If Me.txtDesconto <> "" Then
    Print #iArq, Left("DESCONTO" & String(40, "_"), 40); Right(String(15, "_") & Format(Me.txtDesconto, Right(String(15, "_"), 15) & "R$ #,####,####.00"), 15)
    End If
    Print #iArq, Left("TOTAL" & String(40, "_"), 40); Right(String(15, "_") & Format(Me.txtTotal, Right(String(15, "_"), 15) & "R$ #,####,####.00"), 15)
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    
    'GARANTIA
        Set cns = CurrentDb.OpenRecordset("cnsToWord")
            Do While Not cns.EOF
            If cns("IdOrdem") = Me.IdOrdem And cns("Add") = True Then
            Servico = ""
            Servico = Servico & cns("Servico")
            Garantia = ""
            Garantia = Garantia & cns("Garantia")
        Print #iArq, Servico; ":"; Space(2); Garantia
                cns.MoveNext
            End If
        Loop
        
            
    Print #iArq, "CAMPOS"
    Print #iArq, "CAMPOS"
    Print #iArq, "Atenciosamente,"


    Close #iArq
        DoCmd.Close
        
    MsgBox "Seu orçamento foi criado com sucesso"
        
End Sub

A questão é que mesmo portando desta metodologia não consigo atribui-lá a criação de arquivos .doc, na verdade acho
que após efetuar este modelo me compliquei mais ainda pois não consegui atribuir nenhum dos critérios acima aos exemplos
postados anteriormente e agora estou mais perdido que antes.

Se puderem me indicar um caminho a solução agradeço.

Boa tarde,
O Word não é assim tão limitado.
Veja para o exemplo da data e adapte para o restante
Private Sub btnEnviar_Click()
Dim appWord As Object, Cambio

'A Aplicação é criada aqui:
Set appWord = CreateObject("Word.Application")
'A linha abaixo é importante: você deve querer que
'sua aplicação seja visível na maioria das vezes
appWord.Visible = True

'Note que, na linha abaixo, foi adicionado um Documento
'dentro da Aplicação appWord:
appWord.Application.Documents.Open (EnderecoCompletoDoFicheiroAAbrir)
Set Cambio = appWord.ActiveWindow.Selection.Find

Cambio.Execute "DtAtual", False, , , , , , , , Me.DtAtual, 2

appWord.SaveAs2 FileName:="C:\Orcamentos\Doc1", FileFormat:=wdFormatXMLDocument
MsgBox "Orçamento criado com sucesso"

'Agora, deseja-se sair da Aplicação. Observe que o método é executado
'no nível da Aplicação, finalizando a Aplicação e todos os objetos
'criados por ela:
appWord.Quit

'Apenas para limpar memória
Set appWord = Nothing

End Sub

Com a permissão dos colegas deixo aqui esse tópico no qual coloquei algumas explicações e exemplos sobre exportação do Access para o Word, inclusive exportando as linhas de um subformulário.

Boas,

Alexandre, grato pela resposta. Mas o tópico recomendado pelo Criquio é exatamente o que eu procurava.

Criquio obrigado pelo conselho, adaptei meu projeto exatamente como o seu exemplo. Mas infelizmente ainda não me é exibido os demais registros
do subformulário. A diferença é que ao invés de estar pegando os dados diretamente da tabela fiz uma consulta.

Segue codigo:

Código:

Dim DocWord As Object
 
    Set DocWord = CreateObject("Word.Application")
    With DocWord
        .Visible = True

        .Documents.Add Template:=CurrentProject.Path & "\TamplateOrcamentos\Template Alpha.doc", NewTemplate:=False, DocumentType:=0
'============================================================================================================
        .ActiveDocument.Bookmarks("Data").Select
        .Selection.Text = Format(Now, "General Date")
        
Dim cns As Recordset
Dim Servico As String, Descricao As String, Preco As String, Desconto As String, Total As String

    Set cns = CurrentDb.OpenRecordset("cnsOrcamento")
        Do While Not cns.EOF
            If Me.IdOrdem = cns!IdOrdem Then
    Servico = ""
    Servico = Servico & cns!Servico
    
    Descricao = ""
    Descricao = Descricao & cns!Descricao
    
    Preco = ""
    Preco = Preco & cns!Preco
    
    Desconto = ""
    Desconto = Desconto & Me.txtDesconto
    
    Total = ""
    Total = Total & Me.txtTotal
        End If
    cns.MoveNext
Loop

        .ActiveDocument.Bookmarks("Servicodesc").Select
        .Selection.Text = Servico

        .ActiveDocument.Bookmarks("Descricao").Select
        .Selection.Text = Descricao

        .ActiveDocument.Bookmarks("Servicopreco").Select
        .Selection.Text = Servico

        .ActiveDocument.Bookmarks("Preco").Select
        .Selection.Text = Preco
        
        .ActiveDocument.Bookmarks("Desconto").Select
        .Selection.Text = Desconto
        
        .ActiveDocument.Bookmarks("Total").Select
        .Selection.Text = Total

'============================================================================================================
        .ActiveDocument.SaveAs CurrentProject.Path & "\" & Me.IdOrdem & ".doc"
        
    .ActiveDocument.Close
    End With
    DocWord.Quit

    Set DocWord = Nothing

    MsgBox "Orçamento criado com sucesso"

e Bd caso aja necessidade de demais esclarecimentos:
ToWord.zip

poderia dizer onde estou errado, já tentei de diversas maneiras mas ainda não obtive exito.

Boas amigo Criquio,

Não sei se visualizou este tópico ou teve tempo de verificar o código ou bd anexado.

Se puder ajudar, ainda no aguardo pois não encontrei o meu erro ainda.

Consultas são queries. Tente trocar OpenRecordset por OpenQuery.

Grato pela resposta, mas o erro persiste.

Tentei da seguinte maneira: Set cns = CurrentDb.OpenQuerry("cnsOrcamento") e me é gerado o erro: Método ou membro de dados não encontrado.
E outras maneiras seguindo o mesmo padrão e também me são gerados erros.

Boas amigo Criqui,

Ainda no aguardo, como postado anteriormente a dica não surtiu resultados.

Boa tarde,
OpenQuery e não OpenQuerry

Boa noite Alexandre,

Desculpe, ao digitar a linha erronia aqui no fórum adicionei um R a mais.
Mas o erro é o mesmo e ainda não solucionei o motivo de não estar enviando os sub-campos para o word.