COLOCAR ARQUIVOS NO WORD, EXCEL

olha se isso te ajuda amigo

Private Sub cmdGerarContrato_Click()
Dim CaminhoContrato As String
Dim conta As Integer
Dim NomeArquivo As String

'On Error GoTo ErrorHandler

If txtNomeArquivo.Text = "" Then
MsgBox "O Nome do Arquivo a ser gerado, deve ser informado.", vbExclamation
txtNomeArquivo.SetFocus
Exit Sub
End If

CaminhoContrato = CaminhoBD
conta = Len(CaminhoContrato)
conta = conta - 6
CaminhoContrato = Left(CaminhoContrato, conta)
CaminhoContrato = CaminhoContrato & "Contratos"

Set objword = New word.Application
Set objword1 = New word.Application
' Desabilita o botao de comando
'cmdGerarContrato.Enabled = False
' nome do relatorio pré montado
objword.Documents.Open (CaminhoContrato & "Contrato01.doc")

' chama rotina para substituicao
Call Substitui_Var("@n", txtCodigoContrato)
Call Substitui_Var("@locador", txtLocador)
Call Substitui_Var("@nacionalidadeLocador", NacionalidadeLocador)
Call Substitui_Var("@cpfLocador", CpfLocador)
Call Substitui_Var("@profissaoLocador", ProfissaoLocador)
Call Substitui_Var("@estadocivilLocador", EstadoCivilLocador)

'Locatário
Call Substitui_Var("@locatario", txtLocatario)
Call Substitui_Var("@nacionalidadeLocatario", NacionalidadeLocatario)
Call Substitui_Var("@cpfLocatario", CpfLocatario)
Call Substitui_Var("@profissaoLocatario", ProfissaoLocatario)
Call Substitui_Var("@estadocivilLocatario", EstadoCivilLocatario)

'Endereço do Imóvel
Call Substitui_Var("@EndecoImovel", EnderecoImovel)

'Descricao
Set tbDescricaoContrato = db.OpenRecordset("SELECT * FROM tabContratoImoveisDescricao WHERE Codigo_Contrato Like '*" & txtCodigoContrato.Text & "' ORDER BY Id Asc")

For i = 1 To tbDescricaoContrato.RecordCount
'objword.Selection.Font.Bold = True
Call Substitui_Var("@Comodo", tbDescricaoContrato.Fields("Comodo") & ": ")
'objword.Selection.Font.Bold = False
Call Substitui_Var("@descricao", tbDescricaoContrato.Fields("Descricao"))

objword.Selection.TypeParagraph

tbDescricaoContrato.MoveNext
Next i

'
Call Substitui_Var("@leituraCemig", LeituraCemig)
Call Substitui_Var("@leituraCopasa", LeituraCopasa)

Call Substitui_Var("@valorMensal", ValorImovel)

Call Substitui_Var("@procurador", txtProcurador)

Call Substitui_Var("@prazoLocacao", cmbPrazoLocacao)

Call Substitui_Var("@dataInicio", txtDataInicio)

Call Substitui_Var("@obs", txtObservacao)

Call Substitui_Var("@Finalidade", cmbFinalidade)

'Fiador 1
Call Substitui_Var("@Fiador1", NomeFiador1)

Call Substitui_Var("@EnderecoFiador1", EnderecoFiador1)

Call Substitui_Var("@cpfFiador1", CPFFiador1)

Call Substitui_Var("@rgFiador1", RGFiador1)

Call Substitui_Var("@EstadoCivilFiador1", EstadoCivilFiador1)

'Fiador 2
Call Substitui_Var("@Fiador2", NomeFiador2)

Call Substitui_Var("@EnderecoFiador2", EnderecoFiador2)

Call Substitui_Var("@cpfFiador2", CPFFiador2)

Call Substitui_Var("@rgFiador2", RGFiador2)

Call Substitui_Var("@EstadoCivilFiador2", EstadoCivilFiador2)

Call Substitui_Var("@locadorProcuracao", txtProcurador)

Call Substitui_Var("@locatario1", txtLocatario)

Call Substitui_Var("@fiador1", NomeFiador1)

Call Substitui_Var("@fiador2", NomeFiador2)

NomeArquivo = txtNomeArquivo.Text & ".doc"

' Salva o documento com um novo nome
objword.ActiveDocument.SaveAs (CaminhoContrato & "Contratos Gerados" & NomeArquivo)
'Encerra o word
objword.Quit

MsgBox "Contrato gerado com sucesso! em : " & CaminhoContrato & "Contratos Gerados", vbInformation, " Contrato Gerado "

If MsgBox("Deseja Abrir o Contrato Gerado?", vbInformation + vbYesNo, "AVISO") = vbYes Then
' abri o arquivo gerado
Dim word As New word.Application

With word
   .Documents.Open (CaminhoContrato & "Contratos Gerados" & NomeArquivo)
   .Visible = True
   .WindowState = wdWindowStateMaximize
End With

End If

' libera memoria
Set objword = Nothing

Exit Sub

ErrorHandler:       ' Rotina de tratamento de erro.
  Select Case Err.Number
   Case 5152
   MsgBox "Atenção! O Nome do Contrato Gerado não pode ter Caracteres Especiais.", vbInformation
   Case 5356
   MsgBox "Atenção! O Arquivo pode estar aberto na memoria do sistema. Feche o Sistema", vbInformation
End Select

End Sub

Private Sub Substitui_Var(Header As String, Data As String)
On Error GoTo ErrorHandler

  With objword.Selection.Find
     .ClearFormatting
     .Text = Header
     .Execute Forward:=True
  End With

  Clipboard.Clear
  Clipboard.SetText (Data)
  objword.Selection.Paste
  Clipboard.Clear

ErrorHandler:       ' Rotina de tratamento de erro.
  Select Case Err.Number
   Case 4198
   MsgBox "Atenção! Falta preencher algum campo do contrato.", vbExclamation
   Exit Sub
End Select

End Sub