I have a folder full of word documents I need to transfer to Excel. I need to convert multiple Word documents that basically consist out of one big table into multiple Excel sheets in one workbook.
I found the following code:
Sub Demo()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, xlSheet As Worksheet
Dim wdApp As Object, wdDoc As Object
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set wdApp = CreateObject("Word.Application")
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set xlSheet = ThisWorkbook.Sheets.Add
Set wdDoc = wdApp.Documents.Open(strFolder & "\" & strFile)
With wdDoc
.Range.Copy
.Close False
End With
xlSheet.Paste
strFile = Dir()
Wend
Set wdDoc = Nothing: Set xlSheet = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
It works to a point until it gives me "Run-Time error '1004': Method 'Paste' of object'_Worksheet' failed" and then stops with still a few sheets to process.
Debugging Highlights xlSheet.Paste.
Any idea how to fix this to run through all the word filesand copy them?
I'd like to open a bunch of word files, from a list of file names in my excel workbook, activate the opened word files, perform a text replacement, and save the changes.
I can't make the liaison between Excel VBA and Word files.
Dim wdApp As Object, wddoc As Object
'Declare a string variable for Word document
Dim strDocName As String
On Error Resume Next
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
strDocName = xDPathStr \ "FILENAME.docx" '(xDPathStr is the path I have defined earlier with all the word files)'
'Open Word File
wdApp.Activate
Set wddoc = wdApp.Documents(strDocName)
If wddoc Is Nothing Then Set wddoc = wdApp.Documents.Open(strDocName)
wddoc.Activate
wrdApp.Visible = True
Modify Word Files From a List in Excel
It is assumed that the file names are in column A. It will open each file and replace all occurrences of one string with another.
The focus here is on how to reference (open) Word, open files, modify them (not so much), close them with saving changes, and finally close Word only if it was initially closed.
Option Explicit
Sub VisitWord()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Late Binding (not recommended at this stage)
' When you get familiar with how it works, switch to Late Binding:
' Dim wdApp As Object
' Dim WordWasClosed As Boolean
' On Error Resume Next ' see if Word is open
' Set wdApp = GetObject(, "Word.Application") ' attempt to create a reference to it
' On Error GoTo 0
' If wdApp Is Nothing Then ' Word is not open
' WordWasClosed = True
' Set wdApp = CreateObject("Word.Application") ' open and create a reference to it
' End If
' wdApp.Visible = True ' default is false; outcomment when done testing
' Dim wdDoc As Object
' ' etc.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Early Binding
' For this to work, in Excel, you need to create a reference to
' Tools > References > Microsoft Word 16.0 Object Library
' Use this to have the Word intellisense work for you.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const WordFolderPath As String = "C:\Test\"
Const FINDSTRING As String = "Old String"
Const REPLACESTRING As String = "New String"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim rg As Range
Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
Dim wdApp As Word.Application
Dim WordWasClosed As Boolean
On Error Resume Next ' see if Word is open
Set wdApp = Word.Application ' attempt to create a reference to it
On Error GoTo 0
If wdApp Is Nothing Then ' Word is not open
WordWasClosed = True
Set wdApp = New Word.Application ' open and create a reference to it
End If
wdApp.Visible = True ' default is false; outcomment when done testing
Dim cell As Range
Dim wdDoc As Word.Document
Dim WordFileName As String
Dim WordFilePath As String
For Each cell In rg.Cells
WordFileName = CStr(cell.Value)
If Len(WordFileName) > 0 Then
WordFilePath = WordFolderPath & WordFileName
If Len(Dir(WordFilePath)) > 0 Then ' file exists
Set wdDoc = wdApp.Documents.Open(WordFilePath)
' Here you do the damage...
wdDoc.Content.Find.Execute _
FindText:=FINDSTRING, _
ReplaceWith:=REPLACESTRING, _
Format:=True, _
Replace:=wdReplaceAll
wdDoc.Close SaveChanges:=True
End If
End If
Next cell
If WordWasClosed Then wdApp.Quit
End Sub
So this is the code i've come up with so far:
Dim wdApp As Object, wddoc As Object
'Declare a string variable for Word document
Dim strDocName As String
On Error Resume Next
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
strDocName = xDPathStr \ "FILENAME.docx" '(xDPathStr is the path I have defined earlier with all the word files)'
'Open Word File
wdApp.Activate
Set wddoc = wdApp.Documents(strDocName)
If wddoc Is Nothing Then Set wddoc = wdApp.Documents.Open(strDocName)
wddoc.Activate
wrdApp.Visible = True
Here is some sample code that I created recently to loop through cells in Excel, which are paths to Word files. Each Word file is opened, scanned for a table (in Word), and copy/paste to Excel. See if you can start with this. Post back if you have additional questions.
Sub LoopThroughAllWordFiles()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim oTbl As Word.Table
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet
Dim cnt As Long
Dim tableCount As Long
Dim lrow As Long
Dim lastrow As Long
Dim file As String
Dim rng As Range, cell As Range
Dim objDoc As Object
Dim objWord As Object
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Set rng = Worksheets("Files").Range("A1:A200")
Worksheets("Word_Tables").Select
filecounter = 1
cnt = 1
Set objWord = CreateObject("Word.Application")
obj.Word.Visible = False
For Each cell In rng.SpecialCells(xlCellTypeVisible)
MyStr = Right(cell, 5)
If MyStr = ".docx" Then
mylength = Len(cell)
pos = InStrRev(cell, "\")
strFolder = Left(cell, pos)
strFile = Right(cell, mylength - pos)
Worksheets("Word_Files").Select
Set objWord = wdApp.Documents.Open(Filename:=strFolder & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
Set sht = ThisWorkbook.Worksheets("Word_Files")
lastrow = Worksheets("Word_Files").UsedRange.Rows.Count + 1
totTbl = objDoc.Tables.Count
Debug.Print totTbl
For Each oTbl In objDoc.Tables
strCellText = oTbl.cell(1, 1).Range.Text
strCellText = LCase(strCellText)
Debug.Print strCellText
If strCellText Like "*data input*" Then
Worksheets("Word_Files").Range("A" & lastrow) = strFolder & strFile
On Error Resume Next
If cnt = 1 Then
lastrow = lastrow
Else
lastrow = ActiveSheet.UsedRange.Rows.Count
End If
oTbl.Range.Copy
Range("B" & lastrow).Select
sht.Paste
cnt = cnt + 1
End If
Next oTbl
End If
filecounter = filecounter + 1
Debug.Print filecounter
objWord.Close
Next cell
objDoc.Quit
Set objDoc = Nothing
objWord.Quit
Set objWord = Nothing
SecondsElapsed = Round(Timer - StartTime, 2)
SecondsFinal = SecondsElapsed / 60
MsgBox ("Code ran in " & SecondsFinal & "minutes.")
End Sub
I am trying to convert a pdf file to an excel file (xlsx) using excel VBA.
The problem is the code seems to be perfectly fine as I have seen it working on other computers in action, but for some reason, I am getting a run time error and I am trying to solve this for a week.
Below is the code
Option Explicit
Function ClearCipboard()
'Early binding will requires a Reference to 'Microsoft Forms 2.0 Object Library'
Dim oData As Object 'New MSForms.DataObject
Set oData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
oData.SetText Text:=Empty
oData.PutInClipboard
Set oData = Nothing
End Function
Sub Automate()
Dim PathforPDFfiles As String
Dim PathforExcelfiles As String
PathforPDFfiles = "C:\Users\kvenkat2\Desktop\Trails 18.06.2021\Test File Excel\PDF-to-Excel-Converter\"
PathforExcelfiles = "C:\Users\kvenkat2\Desktop\Trails 18.06.2021\Test File Excel\PDF-to-Excel-Converter\"
Dim fso As New FileSystemObject
Dim myFolder As Folder
Dim myFile As File
Set myFolder = fso.GetFolder(PathforPDFfiles)
Dim WordApp As Object
Dim WordDoc As Object
Dim WordRange As Object
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set WordApp = CreateObject("word.application")
'Set WordDoc = WordApp.documents.Add
'Set WordApp = New Word.Application
WordApp.Visible = True
Dim nwb As Workbook
Dim nsh As Worksheet
For Each myFile In myFolder.Files
Set WordDoc = WordApp.documents.Open(myFile.Path, False, Format:="PDF Files")
Set WordRange = WordDoc.Paragraphs(1).Range
WordRange.WholeStory
Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
WordRange.Copy
nsh.Paste
nwb.SaveAs (PathforExcelfiles & Replace(myFile.Name, ".pdf", ".xlsx"))
Application.CutCopyMode = False
Call ClearCipboard
WordDoc.Close True
nwb.Close True
Next
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
Application.displayAlters = True
Application.ScreenUpdating = False
MsgBox ("Done for real")
End Sub
Set WordDoc = WordApp.documents.Open(myFile.Path, False, Format:="PDF Files")
This is the part where my code stops running and I try to see the opened word and nothing happens from here. I am unable to get past this line.
It shows as a run time error as shown in the image
Good afternoon,
I am wondering how to open the Word file, which has some fixed part of the string in its name.
Prevously I was trying to open in under the fixed name:
VBA Excel problem with opening the Word file
Now, I am going a step further and want to make my file more flexible.
I tried the following code:
Sub Rams()
Dim appWD As Word.Application
Set appWD = New Word.Application
Dim docWD As Word.Document
Dim DocName As String
DocName = "*RAMS*"
Set docWD = appWD.Documents.Open(ActiveWorkbook.path & "\" DocName & ".docx.docm")
appWD.Visible = True
But the debugger sets, that it's the syntax error (some parenthesis is missing here, but I don't know where.
I also tried:
Sub Rams()
Dim appWD As Word.Application
Set appWD = New Word.Application
Dim docWD As Word.Document
Set docWD = appWD.Documents.Open(ActiveWorkbook.path & "\*RAMS*.docx.docm")
appWD.Visible = True
But I am getting pretty much similar error to the previous situation. Theoretically, I know, that these symbols mustn't be there, although I don't know how to write it properly.
UPDATE:
With reference to the hints in the comments I tried sth like this:
Sub Rams2()
Dim appWD As Word.Application
Dim iIndex As Integer
Dim strPath As String
Dim strFile As String
strPath = ActiveWorkbook.path
strFile = Dir(strPath & "*RAMS*.docx.docm")
Do While strFile <> ""
Set wb = Workbooks.Open(filename:=strPath & strFile)
For iIndex = 1 To wb.Worksheets.Count
Set ws = wb.Worksheets(iIndex)
'Do something here.
Next Index
strFile = Dir 'This moves the value of strFile to the next file.
Loop
Set appWD = New Word.Application
Dim docWD As Word.Document
appWD.Visible = True
End Sub
NEXT UPDATE:
I found some solutions here:
https://www.techonthenet.com/excel/formulas/dir.php
and here
https://www.exceltrick.com/formulas_macros/vba-dir-function/
and finally used the following code:
Sub Rams3()
path = ActiveWorkbook.path & "\RAMS*.docm"
File = Dir(path)
Dim appWD As Word.Application
Set appWD = New Word.Application
Dim docWD As Word.Document
If Len(File) > 0 Then
Set docWD = appWD.Documents.Open(File)
appWD.Visible = True
Else
MsgBox ("File Doesn't Exist")
End If
End Sub
Basically the DIR function works correctly as well as the file opening command, but I don't know, why the path is redirected to WINDOWS/System32/ whereas I set the path for my workbook?
Only Word application is being opened without any documents...
I'm trying to create a report that analyzes multiple word documents in a folder and analyzes checkboxes in the document to determine if a set of tests passed or failed. I have code that loops through all documents in a folder, but I'm having a hard time determining how to determine if the boxes are checked.
The first checkbox I'm trying to evaluate is tagged "PassCheckBox". I've found several articles with syntax on how to do this, but none seem to work with the way I'm iterating through the word files. My current code give me "Object is Required" when I try to run.
Here is my current code:
Sub ParseTestFiles()
Dim FSO As Object
Dim fPath As String
Dim myFolder, myFile
Dim wdApp As Object
Dim PassValue As Boolean
fPath = ActiveWorkbook.Path
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = FSO.GetFolder(fPath).Files
For Each myFile In myFolder
If LCase(myFile) Like "*.doc" _
Or LCase(myFile) Like "*.docx" Or LCase(myFile) Like "*.docm" Then
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word not yet running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
wdApp.Documents.Open CStr(myFile)
wdApp.Visible = True
' Here is where I'm having an issue
PassValue = ActiveDocument.FormFields("PassCheckBox").Checked
Set wdApp = Nothing
End If 'LCase
Next myFile
End Sub
Try to use:
Dim c, wdDoc
Set wdDoc = wdApp.Documents.Open(CStr(myFile))
wdApp.Visible = True
For Each c In wdDoc.ContentControls
If c.Title = "PassCheckBox" Then
PassValue = c.Checked
Exit For
End If
Next
instead
wdApp.Documents.Open CStr(myFile)
wdApp.Visible = True
PassValue = ActiveDocument.FormFields("PassCheckBox").Checked