[Resolvido]Módulo VBA

Boa tarde,
Amigos estou a necessitar de ajuda, no código abaixo está dando erro na rs1.NomeDaEmpresa, diz que o obejto não existe, não sei onde estou errando, eu declarei as variáveis e abri a tabela. eu usei um exemplo do amigo JPaulo.

Option Compare Database
Option Explicit

#Const DESENV = -1

Private Sub btWord_Click()
On Error GoTo TrataErro
Dim oApp As Object
Dim cnn As New ADODB.Connection
'Declara variável rs1 para os registros
Dim rs1 As ADODB.Recordset
'Abre a conexão com o banco
Set cnn = CurrentProject.Connection
'Abre a conexão com o registro
Set rs1 = New ADODB.Recordset
rs1.CursorType = adOpenKeyset
rs1.LockType = adLockOptimistic
'Abre a Tabela_Produtos
rs1.Open "Clientes", cnn, , , adCmdTable
rs1.Find "CódigoDoCliente=" & Me.CódigoDoCliente, 0, adSearchForward, 1
' Inicia o MS Word
Set oApp = CreateObject("Word.Application")
With oApp
' Torna o MS Word visível
Visible = True
' Abre o documento
.Documents.Open "C:\Users\Eduardo\Desktop\combinawordaccess\TemplateCartas\Cartinha.doc"
'Move cada campo para o indicador definido no documento
.ActiveDocument.Bookmarks("NomeDaEmpresa").Select
.Selection.Text = Trim(CStr(rs1.NomeDaEmpresa))
.ActiveDocument.Bookmarks("Endereço").Select
.Selection.Text = Trim(CStr(rs1.Endereço))
.ActiveDocument.Bookmarks("Cidade").Select
.Selection.Text = Trim(CStr(rs1.Cidade))
.ActiveDocument.Bookmarks("Região").Select
.Selection.Text = Trim(CStr(rs1.Região))
.ActiveDocument.Bookmarks("CEP").Select
.Selection.Text = Trim(rs1.CEP)
.ActiveDocument.Bookmarks("NomeDoContato").Select
.Selection.Text = Trim(CStr(rs1.NomeDoContato))
.ActiveDocument.Bookmarks("NomeDoContato1").Select
.Selection.Text = Trim(CStr(rs1.NomeDoContato))
.ActiveDocument.Bookmarks("NomeDaEmpresa1").Select
.Selection.Text = Trim(CStr(rs1.NomeDaEmpresa))
.ActiveDocument.Bookmarks("NomeDoContato2").Select
.Selection.Text = Trim(CStr(rs1.NomeDoContato))
.ActiveDocument.Bookmarks("Cargo").Select
.Selection.Text = Trim(CStr(rs1.CargoDoContato))
.ActiveDocument.Bookmarks("Endereço1").Select
.Selection.Text = Trim(CStr(rs1.Endereço))
.ActiveDocument.Bookmarks("Cidade1").Select
.Selection.Text = Trim(CStr(rs1.Cidade))
.ActiveDocument.Bookmarks("Região1").Select
.Selection.Text = Trim(CStr(rs1.Região))
.ActiveDocument.Bookmarks("CEP1").Select
.Selection.Text = Trim(CStr(rs1.CEP))
.ActiveDocument.Bookmarks("País").Select
.Selection.Text = Trim(CStr(rs1.País))
.ActiveDocument.Bookmarks("Telefone").Select
.Selection.Text = Trim(CStr(rs1.Telefone))
.ActiveDocument.Bookmarks("Fax").Select
.Selection.Text = Trim(CStr(rs1.Fax))

.ActiveDocument.SaveAs "C:\Users\Eduardo\Desktop\combinawordaccess\TemplateCartas\" & rs1.CódigoDoCliente & " " & Format(Date, "dd-mm-yy") & " " & Format(Now, "hhmmss") & ".doc"

.ActiveDocument.Close
MsgBox "Documento salvo com sucesso...", vbInformation
End With
oApp.Quit
Set oApp = Nothing

'Fecha os registros
rs1.Close
'Fecha a conexão
cnn.Close
'Fecha a conexão com o banco
Set cnn = Nothing
'Fecha a conexão com o registro
Set rs1 = Nothing

Saida:
Exit Sub

TrataErro:
'Se um campo do formulário estiver vazio, remove o texto do Indicador e continua
If Err.Number = 94 Then
oApp.Selection.Text = ""
Resume Next
End If
MsgBox "Form_Clientes - btWord_Click" & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
#If DESENV Then
oApp.Quit
Set oApp = Nothing
Stop
Resume
#End If
Resume Saida
End Sub

Boa tarde,

É porque o campo NomeDaEmpresa não existe na tabela Clientes

Bom dia Alexandre,

O todos os campos que estão no código existem na tabela clientes.
vou postar o bd caso queira dar uma olhada.
http://dl.dropbox.com/u/34480647/AccessWord_Stella.mdb

Obrigado.

Boa tarde, lionduda

Só agora reparei que se trata do primeiro campo chamado, o que indica que a ligação à tabela não foi assumida.
Não trabalho com conexão mas com DAO. Veja se funciona assim:
Private Sub btWord_Click()
On Error GoTo TrataErro
Dim oApp As Object
'Declara variável rs1 para os registros
Dim rs1 As DAO.Recordset
Set rs1 = Currentdb.openrecordset("SELECT * FROM Clientes;")
rs1.Find "CódigoDoCliente=" & Me.CódigoDoCliente
if rs1.nomatch then msgbox"Registo não encontrado" : goto saida
' Inicia o MS Word
Set oApp = CreateObject("Word.Application")
With oApp
' Torna o MS Word visível
Visible = True
' Abre o documento
.Documents.Open "C:\Users\Eduardo\Desktop\combinawordaccess\TemplateCartas\Cartinha.doc"
'Move cada campo para o indicador definido no documento
.ActiveDocument.Bookmarks("NomeDaEmpresa").Select
.Selection.Text = Trim(CStr(rs1.NomeDaEmpresa))
.ActiveDocument.Bookmarks("Endereço").Select
.Selection.Text = Trim(CStr(rs1.Endereço))
.ActiveDocument.Bookmarks("Cidade").Select
.Selection.Text = Trim(CStr(rs1.Cidade))
.ActiveDocument.Bookmarks("Região").Select
.Selection.Text = Trim(CStr(rs1.Região))
.ActiveDocument.Bookmarks("CEP").Select
.Selection.Text = Trim(rs1.CEP)
.ActiveDocument.Bookmarks("NomeDoContato").Select
.Selection.Text = Trim(CStr(rs1.NomeDoContato))
.ActiveDocument.Bookmarks("NomeDoContato1").Select
.Selection.Text = Trim(CStr(rs1.NomeDoContato))
.ActiveDocument.Bookmarks("NomeDaEmpresa1").Select
.Selection.Text = Trim(CStr(rs1.NomeDaEmpresa))
.ActiveDocument.Bookmarks("NomeDoContato2").Select
.Selection.Text = Trim(CStr(rs1.NomeDoContato))
.ActiveDocument.Bookmarks("Cargo").Select
.Selection.Text = Trim(CStr(rs1.CargoDoContato))
.ActiveDocument.Bookmarks("Endereço1").Select
.Selection.Text = Trim(CStr(rs1.Endereço))
.ActiveDocument.Bookmarks("Cidade1").Select
.Selection.Text = Trim(CStr(rs1.Cidade))
.ActiveDocument.Bookmarks("Região1").Select
.Selection.Text = Trim(CStr(rs1.Região))
.ActiveDocument.Bookmarks("CEP1").Select
.Selection.Text = Trim(CStr(rs1.CEP))
.ActiveDocument.Bookmarks("País").Select
.Selection.Text = Trim(CStr(rs1.País))
.ActiveDocument.Bookmarks("Telefone").Select
.Selection.Text = Trim(CStr(rs1.Telefone))
.ActiveDocument.Bookmarks("Fax").Select
.Selection.Text = Trim(CStr(rs1.Fax))

.ActiveDocument.SaveAs "C:\Users\Eduardo\Desktop\combinawordaccess\TemplateCartas\" & rs1.CódigoDoCliente & " " & Format(Date, "dd-mm-yy") & " " & Format(Now, "hhmmss") & ".doc"

.ActiveDocument.Close
MsgBox "Documento salvo com sucesso...", vbInformation
End With
oApp.Quit
Set oApp = Nothing

'Fecha os registros
rs1.Close
'Fecha a conexão com o banco
Set rs1 = Nothing

Saida:
Exit Sub

TrataErro:
'Se um campo do formulário estiver vazio, remove o texto do Indicador e continua
If Err.Number = 94 Then
oApp.Selection.Text = ""
Resume Next
End If
MsgBox "Form_Clientes - btWord_Click" & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
#If DESENV Then
oApp.Quit
Set oApp = Nothing
Stop
Resume
#End If
Resume Saida
End Sub

Alexandre,

Agora o erro está indo pra linha "rs1.NomeDaEmpresa", eu alterei o método de comparação no CódigodoCliente, coloquei o Seek porque o Find dava erro.
Abaixo o código:


Private Sub btWord_Click()
On Error GoTo TrataErro
Dim oApp As Object
'Declara variável rs1 para os registros
Dim rs1 As DAO.Recordset
Set rs1 = CurrentDb.OpenRecordset("SELECT * FROM Clientes;")
rs1.Seek "CódigoDoCliente=" & Me.CódigoDoCliente, 0, adSearchForward, 1
If rs1.NoMatch Then MsgBox "Registo não encontrado": GoTo Saida
' Inicia o MS Word
Set oApp = CreateObject("Word.Application")
With oApp
' Torna o MS Word visível
Visible = True
' Abre o documento
.Documents.Open "C:\Users\Eduardo\Desktop\combinawordaccess\TemplateCartas\Cartinha.doc"
'Move cada campo para o indicador definido no documento
.ActiveDocument.Bookmarks("NomeDaEmpresa").Select
.Selection.Text = Trim(CStr(rs1.NomeDaEmpresa)) <<<< ERRO
.ActiveDocument.Bookmarks("Endereço").Select
.Selection.Text = Trim(CStr(rs1.Endereço))
.ActiveDocument.Bookmarks("Cidade").Select
.Selection.Text = Trim(CStr(rs1.Cidade))
.ActiveDocument.Bookmarks("Região").Select
.Selection.Text = Trim(CStr(rs1.Região))
.ActiveDocument.Bookmarks("CEP").Select
.Selection.Text = Trim(rs1.CEP)
.ActiveDocument.Bookmarks("NomeDoContato").Select
.Selection.Text = Trim(CStr(rs1.NomeDoContato))
.ActiveDocument.Bookmarks("NomeDoContato1").Select
.Selection.Text = Trim(CStr(rs1.NomeDoContato))
.ActiveDocument.Bookmarks("NomeDaEmpresa1").Select
.Selection.Text = Trim(CStr(rs1.NomeDaEmpresa))
.ActiveDocument.Bookmarks("NomeDoContato2").Select
.Selection.Text = Trim(CStr(rs1.NomeDoContato))
.ActiveDocument.Bookmarks("Cargo").Select
.Selection.Text = Trim(CStr(rs1.CargoDoContato))
.ActiveDocument.Bookmarks("Endereço1").Select
.Selection.Text = Trim(CStr(rs1.Endereço))
.ActiveDocument.Bookmarks("Cidade1").Select
.Selection.Text = Trim(CStr(rs1.Cidade))
.ActiveDocument.Bookmarks("Região1").Select
.Selection.Text = Trim(CStr(rs1.Região))
.ActiveDocument.Bookmarks("CEP1").Select
.Selection.Text = Trim(CStr(rs1.CEP))
.ActiveDocument.Bookmarks("País").Select
.Selection.Text = Trim(CStr(rs1.País))
.ActiveDocument.Bookmarks("Telefone").Select
.Selection.Text = Trim(CStr(rs1.Telefone))
.ActiveDocument.Bookmarks("Fax").Select
.Selection.Text = Trim(CStr(rs1.Fax))

.ActiveDocument.SaveAs "C:\Users\Eduardo\Desktop\combinawordaccess\TemplateCartas\" & rs1.CódigoDoCliente & " " & Format(Date, "dd-mm-yy") & " " & Format(Now, "hhmmss") & ".doc"

.ActiveDocument.Close
MsgBox "Documento salvo com sucesso...", vbInformation
End With
oApp.Quit
Set oApp = Nothing

'Fecha os registros
rs1.Close
'Fecha a conexão com o banco
Set rs1 = Nothing

Saida:
Exit Sub

TrataErro:
'Se um campo do formulário estiver vazio, remove o texto do Indicador e continua
If Err.Number = 94 Then
oApp.Selection.Text = ""
Resume Next
End If
MsgBox "Form_Clientes - btWord_Click" & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
#If DESENV Then
oApp.Quit
Set oApp = Nothing
Stop
Resume
#End If
Resume Saida
End Sub

Com a permissão do mestre Alexandre, tente assim...

.ActiveDocument.Bookmarks("NomeDaEmpresa").Select
.Selection.Text = Trim(CStr(rs1("NomeDaEmpresa")))
.ActiveDocument.Bookmarks("Endereço").Select
.Selection.Text = Trim(CStr(rs1("Endereço")))
.ActiveDocument.Bookmarks("Cidade").Select
.Selection.Text = Trim(CStr(rs1("Cidade")))
.ActiveDocument.Bookmarks("Região").Select
.Selection.Text = Trim(CStr(rs1("Região")))
.ActiveDocument.Bookmarks("CEP").Select
.Selection.Text = Trim(rs1("CEP"))
.ActiveDocument.Bookmarks("NomeDoContato").Select
.Selection.Text = Trim(CStr(rs1("NomeDoContato")))
.ActiveDocument.Bookmarks("NomeDoContato1").Select
.Selection.Text = Trim(CStr(rs1("NomeDoContato")))
.ActiveDocument.Bookmarks("NomeDaEmpresa1").Select
.Selection.Text = Trim(CStr(rs1("NomeDaEmpresa")))
.ActiveDocument.Bookmarks("NomeDoContato2").Select
.Selection.Text = Trim(CStr(rs1("NomeDoContato")))
.ActiveDocument.Bookmarks("Cargo").Select
.Selection.Text = Trim(CStr(rs1("CargoDoContato")))
.ActiveDocument.Bookmarks("Endereço1").Select
.Selection.Text = Trim(CStr(rs1("Endereço")))
.ActiveDocument.Bookmarks("Cidade1").Select
.Selection.Text = Trim(CStr(rs1("Cidade")))
.ActiveDocument.Bookmarks("Região1").Select
.Selection.Text = Trim(CStr(rs1("Região")))
.ActiveDocument.Bookmarks("CEP1").Select
.Selection.Text = Trim(CStr(rs1("CEP")))
.ActiveDocument.Bookmarks("País").Select
.Selection.Text = Trim(CStr(rs1("País")))
.ActiveDocument.Bookmarks("Telefone").Select
.Selection.Text = Trim(CStr(rs1("Telefone")))
.ActiveDocument.Bookmarks("Fax").Select
.Selection.Text = Trim(CStr(rs1("Fax")))

carregue a tabela em access2003

Tópico movido para a sala apropriada

Amigos, usei a dica do amigo Jungli e o erro do NomedaEmpresa foi resolvido o problema agora é este:

Variável de objeto ou variável do bloco With não definida (Erro 91)

#If DESENV Then
oApp.Quit

Lion

Creio que faltou declarar a variável, como está no primeiro post:

#Const DESENV = -1

Abraços

Amigos me desculpem pela demora na resposta.
Resolvi o meu problema de outro modo, abaixo a solução, utilizei um outro exemplo aqui do fórum e adaptei.


Private Sub CmdImprime_Click()
On Error GoTo TrataErro
'Declara variável rs1 para os registros
Dim cnn As New ADODB.Connection
'Declara variável rs1 para os registros
Dim rs1 As ADODB.Recordset
'Abre a conexão com o banco
Set cnn = CurrentProject.Connection
'Abre a conexão com o registro
Set rs1 = New ADODB.Recordset
rs1.CursorType = adOpenKeyset
rs1.LockType = adLockOptimistic
'Abre a Tabela_Produtos
rs1.Open "Clientes", cnn, , , adCmdTable
'Compara o código do produto entre as tabelas Produtos e a tabela para entradas de produtos.
rs1.Find "Id=" & Me.Id, 0, adSearchForward, 1

Dim AppWord As Object, strFinalDoc As String, DocWord As Object
strFinalDoc = CurrentProject.Path & "\DemoTest.rtf"
'referencio implictamente para evitar problemas de referencias
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = False
Set DocWord = AppWord.Documents.Add(strFinalDoc)
'**********************MARCA******************************************************
'Estos son los códigos que debo reemplazar en cada pasada
'{FECHA} pues la fecha del sistema
'{NOMBRECLIENTE} el nombre del cliente
'{DIRECCION}
'{CIUDAD}
With DocWord.Content.Find
.Execute findtext:="{FECHA}", replacewith:=rs1("NombreContacto"), Format:=True, Replace:=2
.Execute findtext:="{NOMBRECLIENTE}", replacewith:=rs1("NombreCompañía"), Format:=True, Replace:=2
.Execute findtext:="{DIRECCION}", replacewith:=rs1("Dirección"), Format:=True, Replace:=2
.Execute findtext:="{CIUDAD}", replacewith:=rs1("Ciudad"), Format:=True, Replace:=2
'********************* FIN DE MARCA **************************************************
'===============================
DoEvents
'Tienes que probar si para muchos clientes, el codigo se
'comporta bien, por si se llena el Buffer de la Impresora
'======Aqui la orden de impresión de la carta. La quito para no gastar papel
'-----------------
If MsgBox("Imprimir definitivamente la carta al cliente " & vbCrLf & Me.NombreContacto, vbExclamation + vbYesNo, "Confirme") = vbYes Then
AppWord.PrintOut
End If
'-----------------
'======Fin de la orden de impresión
'destruyo este dodumento concreto del cliente una vez imprimido
DocWord.Close False
Set DocWord = Nothing
End With

'destruyo la variable
AppWord.Quit
Set AppWord = Nothing

TrataErro:
'Se um campo do formulário estiver vazio, remove o texto do Indicador e continua
If Err.Number = 94 Then
AppWord.Selection.Text = ""
Resume Next
End If
End Sub

Lion

Esse é o Access, ele permite ter o mesmo resultado, por diferentes maneiras.

Valeu pelo retorno.

Boa sorte!

Título alterado de "Módulo VBA" para "Módulo VBA Access/Word" para facilitar procura dos interessados.