I have a few Word files with the Tables containing Data which I want to export to excel. I've found a script that did it manually. I modified it in the hopes of having it automatically do the same for all files. Each table it finds gets put into a new sheet and then I want it to save with the same File name as the word document. After running the code I get a Compile Error : Type Mismatch
which points towards folder = Dir("C:\Users\user\Desktop\folder")
. Here's the code :
Option Explicit
Sub AA()
Dim oWord As Word.Application
Dim WordNotOpen As Boolean
Dim file As Word.Document
Dim oTbl As Word.Table
Dim FilePath As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim folder As Object
' Prompt for document
Application.ScreenUpdating = False
' Create new workbook
Set wbk = Workbooks.Add(Template:=xlWBATWorksheet)
' Get or start Word
Set oWord = GetObject(Class:="Word.Application")
If Err Then
Set oWord = New Word.Application
WordNotOpen = True
End If
'On Error GoTo Err_Handler
' Open document
Set folder = Dir("C:\Users\user\Desktop\folder")
For Each file In folder
If file.GetExtensionName(file.Path) = "docx" Then
FilePath = "C:\Users\user\Desktop\folder\" & file & ".docx"
Debug.Print FilePath
Set file = oWord.Documents.Open(Filename:=FilePath)
' Loop through the tables
For Each oTbl In file.Tables
' Create new sheet
Set wsh = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
' Copy/paste the table
oTbl.Range.Copy
wsh.Paste
Next oTbl
' Delete the first sheet
Application.DisplayAlerts = False
wbk.Worksheets(1).Delete
Application.DisplayAlerts = True
wsh.SaveAs Filename:=""
End If
Next
'Exit_Handler:
'On Error Resume Next
' oDoc.Close SaveChanges:=False
'If WordNotOpen Then
' oWord.Quit
' End If
' 'Release object references
' Set oTbl = Nothing
'Set oDoc = Nothing
' Set oWord = Nothing
'Application.ScreenUpdating = True
' Exit Sub
'Err_Handler:
' MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " & Err.Number
' Resume Exit_Handler
End Sub