Copy of Excel (OLE Object) and paste as table in word

[AWAISKAZMI]

Dear Experts;

So far I have created a data base that contains a table having 07 fields.

I have successfully export my data (extract from table) to word

Now i am in the need add 08 the field that is "OLE Object" each record have its separate OLE Object (Excel File)

now i want to print (export) table of excel in word..... tried a lot but failed

Kindly help me at which step my code is incorrect.

Private Sub CMD_MY_DOC_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
On Error GoTo errorhandler
Set cn = New ADODB.Connection

rs.ActiveConnection = CurrentProject.Connection
rs.Open ("select * from MySelectedObservations")

' Opening and Writing to Word Documnt
Dim objWord As Object
Dim pathgetter As String
Dim doc As Object

'Dim WordHeaderFooter As HeaderFooter
Dim filepath As String
Set objWord = CreateObject("Word.Application")

pathgetter = DLookup("Word_Path_Field", "WORD_PATH_TBL", "Serial = 1")
filepath = "" & pathgetter & "\Observations " & ".docx"

MsgBox "Please close Observation file first (if opened)"

With objWord
    .Visible = True

Set doc = .Documents.Open(filepath)
End With

Dim DT_TM As String
DT_TM = "Observations up-to " & CStr(Now())

   Dim d As Database
   Dim rs1 As Recordset
   Dim dept As Field
   Dim head As Field
   Dim obs As Field
   Dim rimp As Field
   Dim ratg As Field
   
      
   Set dbs1 = CurrentDb()
   Set rs1 = dbs1.OpenRecordset("MySelectedObservations")
   Set dept = rs1.Fields("Department_Name")
   Set head = rs1.Fields("Observation_Heading")
   Set obs = rs1.Fields("Observation_Details")
   Set tabl = rsl.Fields("Table")
   Set rimp = rs1.Fields("Risk_Implication")
   Set ratg = rs1.Fields("Risk_Category")
   
   
   Dim dept_nm As String
   dept_nm = "abcd"


With objWord.Selection

.Font.Name = "Times New Roman"
.Font.Size = 16
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Font.Color = vbRed
.TypeText DT_TM
.Font.Color = vbBlack
.TypeParagraph

While rs1.EOF = False

If dept_nm <> dept.Value Then

 .Font.Name = "Times New Roman"
 .Font.Size = 10
 .Font.Bold = True
 .Font.Underline = wdUnderlineSingle
 .TypeText dept.Value
 .TypeText ":"
 .TypeParagraph
 dept_nm = dept.Value
 
 End If
 
 .Font.Name = "Times New Roman"
 .Font.Size = 10
 .Font.Bold = True
 .Font.Underline = wdUnderlineSingle
 .TypeText head.Value
 .TypeText ":"
 .TypeParagraph

 .Font.Name = "Times New Roman"
 .Font.Size = 10
 .Font.Bold = False
 .Font.Underline = wdUnderlineNone
 .TypeText obs.Value
 .TypeParagraph
 
'Copy Excel Table Range
 
Dim tbl As Excel.Range
Dim wordtable As Word.Table
Set tbl = tabl.OLEObject.worksheets(Sheet1.Name)


 tbl.Copy
'Paste Table into MS Word
 objWord.Paragraphs(1).Range.PasteExcelTable _
 LinkedToExcel:=False, _
 WordFormatting:=False, _
 RTF:=False

'Autofit Table so it fits inside Word Document
 Set wordtable = objWord.Tables(1)
 wordtable.AutoFitBehavior (wdAutoFitWindow)
   
EndRoutine:
'Optimize Code
'  Application.ScreenUpdating = True
' Application.EnableEvents = True

'Clear The Clipboard
 ' Application.CutCopyMode = False

 .TypeParagraph

 .Font.Name = "Times New Roman"
 .Font.Size = 10
' .Font.TextColor = vbBlack
 .Font.Bold = True
 .Font.Underline = wdUnderlineNone
   
 .TypeText "Risk Implication: "
    
 .Font.Name = "Times New Roman"
 .Font.Size = 10
' .Font.TextColor = vbBlack
 .Font.Bold = False
 .Font.Underline = wdUnderlineNone
    
 .TypeText rimp.Value
 .TypeParagraph
 
 .Font.Name = "Times new Roman"
 .Font.Size = 10
 '.Font.TextColor = vbBlack
 .Font.Bold = True
 .Font.Underline = wdUnderlineNone

 .TypeText "Risk Category: "
  
 .Font.Name = "Times New Roman"
 .Font.Size = 10
 '.Font.TextColor = vbBlack
 .Font.Bold = False
 .Font.Underline = wdUnderlineNone
 
 .TypeText ratg.Value
 .TypeParagraph
 
 .Font.Name = "Times New Roman"
 .Font.Size = 10
 '.Font.TextColor = vbBlack
 .Font.Bold = True
 .Font.Underline = wdUnderlineNone

 .TypeText "Branch Remarks: "
 .TypeParagraph
 .TypeParagraph
 
rs1.MoveNext
Wend
 
'    'Add header and footer

'ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "Audit & Inspection Division"
'ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = Now()
End With

doc.Save
doc.Activate

MsgBox "Your Observation File has been exported at your saved path"

errorhandler:
'MsgBox Err.Description

End Sub

 

[AWAISKAZMI]

No reply so far:banghead:

 

[JHB]

No reply so far:banghead:

Just to get it in place, remember, it's only volunteers here, not employees where you can demand an answer in a short space of time. And 1 hour and 10 minutes is not that long.
You might have used the time to describe what you have tried and what error you've got.
So, where does it fail, (code line, comment out your error handling) and what is the error message?

 

[AWAISKAZMI]

Just to get it in place, remember, it's only volunteers here, not employees where you can demand an answer in a short space of time. And 1 hour and 10 minutes is not that long.
You might have used the time to describe what you have tried and what error you've got.
So, where does it fail, (code line, comment out your error handling) and what is the error message?

Dear sir;

Thanks for your reply.

First all note few important points.
my project is to export data into word file. For other fields you would see my above code. data is correctly exporting into word file.

I have placed an excel file as attachment in a field
now through vba code i want to add table which should be copy from excel file and paste it in my word file.

i have obtained code from following file
thespreadsheetguru.com/blog/2014/5/22/copy-paste-an-excel-table-into-microsoft-word-with-vba[/url]

i could not succeed to call attached excel file, copy data and paste as table it into word file (remember word file is open and table is open). what code i should place in vba that may able me to do so.

I 'll be very thankful to you if you or any access expert could help me.

 

[AWAISKAZMI]

Reply awaited.... Code needed
To get table from excel file stored in a field as attachment
to be copied and pasted into word file

 

[Dystonia]

Hi

Am I understanding your problem correctly ?

a) You want to use Access to open an Excel file
b) Then use Dynamic Data Exchange to transfer data in the Excel worksheet into Word

 

[AWAISKAZMI]

Details are pointwise:
1 i am begginer level user
2 in a table i have different ""text" fields which are being export to word file
My new need is:
I added new field in table as attachment which contains excel file
.
I want to copy table from excel and paste in word file in which i am already exporting my text fields
.
You may see above in my code other fields are exporting
Please please provide me complete code

 

[Dystonia]

You can use the code below to open Excel and copy the contents of a worksheet to the clipboard which you can then paste into word

Rem *********************************
Rem Open Excel Workbook
Rem *********************************
    
    Dim WB As Object
    Dim WS As Object
    Dim XL As Object
    
    Set WB = GetObject("Path and filename to your Excel Workbook.xlsx")
    Set WS = WB.Worksheets(1) ' Alter if not sheet 1 
    Set XL = WB.Application ' identify Excel application
    
Rem *********************************
Rem Make things visible
Rem *********************************

    XL.visible = true
 
    XL.Windows(WB.Name).visible = true
    
    WS.Usedrange.Copy
 
Rem *********************************
Rem Paste into word at the correct point in the Document
Rem *********************************

   ' add your own code here

Rem *********************************
Rem Close Workbook and quit Excel
Rem *********************************

    XL.DisplayAlerts = False
    WB.Close
    XL.DisplayAlerts = True
    XL.Quit

 

[AWAISKAZMI]

Lovely sir...
Thanks... Guide me another thing

 

[AWAISKAZMI]

Lovely sir...
Thanks... Guide me another thing
In my following code i will use

As my excel file is stored in field name "table" which i am calling through variable "tabl"

Shall i use your recommended code as

Set WB = GetObject(tabl)

Am i correct?



My code is

Dim d As Database
Dim rs1 As Recordset
Dim dept As Field
Dim head As Field
Dim obs As Field
Dim tabl As field
Dim rimp As Field
Dim ratg As Field


Set dbs1 = CurrentDb()
Set rs1 = dbs1.OpenRecordset("MySelectedObservations")
Set dept = rs1.Fields("Department_Name")
Set head = rs1.Fields("Observation_Heading")
Set obs = rs1.Fields("Observation_Details")
Set tabl = rsl.Fields("Table")

 

[Dystonia]

You need to post the value of your variable "tabl" so that I can see what it contains

 

[arnelgp]

if your Excel file is in OLE Object field, you need to extract it first before you can use it on your current code.