Spooky7
08-26-2015, 09:20 PM
I would like some help on the below getting an error on sh1 As Wrksheet
Sub wordScrape()Dim wrdDoc As Object, objFiles As Object, fso As Object, wordApp As ObjectDim sh1 As WorksheetDim x As IntegerFolderName = "C:\code" ' Change this to the folder containing your word documentsSet sh1 = ThisWorkbook.Sheets(1)Set fso = CreateObject("Scripting.FileSystemObject")Set wordApp = CreateObject("Word.application")Set objFiles = fso.GetFolder(FolderName).Filesx = 1For Each wd In objFiles If InStr(wd, ".docx") And InStr(wd, "~") = 0 Then Set wrdDoc = wordApp.Documents.Open(wd.Path, ReadOnly = True) sh1.Cells(x, 1) = wd.Name sh1.Cells(x, 2) = Application.WorksheetFunction.Clean(wrdDoc.Tables(3).Cell(Row:=3, Column:=2).Range) 'sh1.Cells(x, 3) = ....more extracted data.... x = x + 1 wrdDoc.Close End IfNext wdwordApp.QuitEnd Sub
Sub wordScrape()Dim wrdDoc As Object, objFiles As Object, fso As Object, wordApp As ObjectDim sh1 As WorksheetDim x As IntegerFolderName = "C:\code" ' Change this to the folder containing your word documentsSet sh1 = ThisWorkbook.Sheets(1)Set fso = CreateObject("Scripting.FileSystemObject")Set wordApp = CreateObject("Word.application")Set objFiles = fso.GetFolder(FolderName).Filesx = 1For Each wd In objFiles If InStr(wd, ".docx") And InStr(wd, "~") = 0 Then Set wrdDoc = wordApp.Documents.Open(wd.Path, ReadOnly = True) sh1.Cells(x, 1) = wd.Name sh1.Cells(x, 2) = Application.WorksheetFunction.Clean(wrdDoc.Tables(3).Cell(Row:=3, Column:=2).Range) 'sh1.Cells(x, 3) = ....more extracted data.... x = x + 1 wrdDoc.Close End IfNext wdwordApp.QuitEnd Sub