VBA Copy Word File Data To Excel

[ranjith2523]

Hello Experts,

Yes, i understand we have multiple threads with the same topic. Before i posting this question i reviewed most of the thread but i didn't get an expected solution.

I am using Office 365 and I just tried the below coding and either it is running for a long time or getting error at "objWord.Selection.WholeStory".

My basic expectation is to simply copy the entire word file (INCLUDING HEADER) and paste it in a specific Tab. (As how we manually do it from Word to Excel)

I would be very helpful for me if anyone help me on this.

Sub ImportSectHWord()


Dim objWord As Object
Dim objDoc As Object
Dim wdFileName


Set objWord = CreateObject("word.Application")
wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")


If wdFileName = False Then Exit Sub


Set objDoc = GetObject(wdFileName)


objWord.Documents.Open (wdFileName)
objWord.Selection.WholeStory
Selection.Copy


Thisworkbook.sheets("Word").Range("A1").Select
ActiveSheet.Paste


objDoc.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit


End Sub

Regards,
Ranjith

 

[DanteAmor]

Try this:

Sub ImportSectHWord()
  Dim WordApp As Object
  Dim objDoc As Object
  Dim wdFileName As Variant
  
  wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")
  If wdFileName = False Then Exit Sub
  Set WordApp = CreateObject("Word.Application")
  Set objDoc = WordApp.Documents.Open(wdFileName)
      
  WordApp.Selection.WholeStory
  WordApp.Selection.Copy
  
  ThisWorkbook.Sheets("Word").Range("A1").Select
  ActiveSheet.Paste
  objDoc.Close False
  WordApp.Quit
  
  Set WordApp = Nothing
  Set objDoc = Nothing
End Sub

 

[ranjith2523]

Try this:

Sub ImportSectHWord()
  Dim WordApp As Object
  Dim objDoc As Object
  Dim wdFileName As Variant
 
  wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")
  If wdFileName = False Then Exit Sub
  Set WordApp = CreateObject("Word.Application")
  Set objDoc = WordApp.Documents.Open(wdFileName)
     
  WordApp.Selection.WholeStory
  WordApp.Selection.Copy
 
  ThisWorkbook.Sheets("Word").Range("A1").Select
  ActiveSheet.Paste
  objDoc.Close False
  WordApp.Quit
 
  Set WordApp = Nothing
  Set objDoc = Nothing
End Sub

Thank you DanteAmor !!!

Yes, you coding is copying the entire content from the work document and pasting it into the tab "Word". From below screen shot, your coding is copying the data from (Please see...

But my concern here is, the coding should copy the Header data too. Is it possible to copy and bring the Header data to Excel Word Tab ? Please advise !!!

 

[ranjith2523]

Thank you DanteAmor !!!

Yes, you coding is copying the entire content from the work document and pasting it into the tab "Word". From below screen shot, your coding is copying the data from (Please see...

But my concern here is, the coding should copy the Header data too. Is it possible to copy and bring the Header data to Excel Word Tab ? Please advise !!!

View attachment 40302

I tried to add the below coding in your macro to just copy the Header from first page of the Word file and paste it in "Word" tab in cell K1. Actually, i want to copy the header just only from the first page of word file and paste it in Cell K1 in "Word" tab.

Dim docSource As Document

Set docSource = wdFileName
docSource.Sections(i).Headers(j).Range.Copy
         ThisWorkbook.Sheets("Word").Range("K1").PasteSpecial (xlValues)

 

[DanteAmor]

Headers and footers are a bit tricky to read. Check the following code to access them.

VBA MS Word - refer to table in document header

Hi I am relatively new to VBA and would be grateful for some help to refer a table in the document header. The code immediately below works fine but when I add this code to a for each loop it generates the runtime error 5941 " the requested member of the collection does not exist" at the...

www.mrexcel.com

Copy RightFooter, Delete Entire Footer, and Paste to LeftFooter

Hello. I'm really stuck on coming up with a viable line of code to do the following: My Word doc has a footer with data in the left, center, and right areas. The right footer area will always have two lines. The first, a five digit number and the second, a date. The document already copies a...

www.mrexcel.com

 

[Macropod]

Depending on what you're trying to achieve, you might also consider embedding the document in the workbook.

 

[DanteAmor]

i want to copy the header just only from the first page of word file and paste it in Cell K1

Try this:

Sub ImportSectHWord()
  Dim WordApp As Object, objDoc As Object
  Dim wdFileName As Variant
  
  wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")
  If wdFileName = False Then Exit Sub
  Set WordApp = CreateObject("Word.Application")
  Set objDoc = WordApp.Documents.Open(wdFileName)
  WordApp.Visible = True
  
  WordApp.Selection.WholeStory
  WordApp.Selection.Copy
  ThisWorkbook.Sheets("Word").Range("A1").PasteSpecial xlPasteValues
  
  WordApp.ActiveDocument.Sections(1).Headers(1).Range.Copy
  ThisWorkbook.Sheets("Word").Range("K1").PasteSpecial xlPasteValues
  
  objDoc.Close False
  WordApp.Quit
  
  Set WordApp = Nothing
  Set objDoc = Nothing
End Sub

 

[ranjith2523]

Y

Try this:

Sub ImportSectHWord()
  Dim WordApp As Object, objDoc As Object
  Dim wdFileName As Variant
 
  wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")
  If wdFileName = False Then Exit Sub
  Set WordApp = CreateObject("Word.Application")
  Set objDoc = WordApp.Documents.Open(wdFileName)
  WordApp.Visible = True
 
  WordApp.Selection.WholeStory
  WordApp.Selection.Copy
  ThisWorkbook.Sheets("Word").Range("A1").PasteSpecial xlPasteValues
 
  WordApp.ActiveDocument.Sections(1).Headers(1).Range.Copy
  ThisWorkbook.Sheets("Word").Range("K1").PasteSpecial xlPasteValues
 
  objDoc.Close False
  WordApp.Quit
 
  Set WordApp = Nothing
  Set objDoc = Nothing
End Sub

Yes this is what i expected.. Thank you so much for your timely help

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.