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
Related
Sub MyTemplate()
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim wordMailMerge As Word.MailMerge
Dim wordPath As String
Dim excelPath As String
CurrentWorksheet = ActiveSheet.Name
excelPath = ThisWorkbook.Path & "\Sticker Maker.xlsm"
wordPath = ThisWorkbook.Path & "\Inventory Labels.docx"
Set wordApp = CreateObject("Word.Application")
Set wordDoc = wordApp.Documents.Open(wordPath)
Set wordMailMerge = wordDoc.MailMerge
wordMailMerge.OpenDataSource Name:=excelPath, SQLStatement:="SELECT * FROM `'Barcode$'`"
wordMailMerge.Execute
'wordDoc.Close
wordApp.Visible = True
Set wordMailMerge = Nothing
Set wordDoc = Nothing
Set wordApp = Nothing
Sheets(CurrentWorksheet).Select
End Sub
The portion of this code that opens the excel file
wordMailMerge.OpenDataSource Name:=excelPath, SQLStatement:="SELECT * FROM 'Barcode$'"
throws an error because the file is already open. (that file is where the code is running) I just need it to assign the data from the workbook without opening it. because it will already be open running the macro.
Add the read only property when opening the file:
wordMailMerge.OpenDataSource Name:=excelPath, ReadOnly:=True, SQLStatement:="SELECT * FROM `'Barcode$'`"
I am trying to copy a table from excel to word and then back again to excel using VBA. I have a script to do both of those things but how can I make the copy from word back to excel from the active word file that got created with "Copy2word" so that I dont have to specify the location of the word document in "Copy2excel"?
Sub Copy2word()
Dim wdApp As Object
Dim wdDoc As Object
Dim wkSht As Worksheet
'\\ Stay on any sheet from which you want to copy data
Set wkSht = ActiveSheet
wkSht.UsedRange.Copy
'\\ Start word and create new document to paste data
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
End If
Set wdDoc = wdApp.Documents.Add
'\\ Paste Data from Excel
wdDoc.Range.PasteExcelTable False, False, True
'\\ Stop Excel's cut copy mode
Application.CutCopyMode = False
MsgBox "Copy to Word Finished!", vbInformation, "Copy to Word"
End Sub
Sub Copy2excel()
Const DOC_PATH As String = "C:\Users\MASS\Desktop\Test\TK1.docx"
Dim sht As Worksheet
Dim WordDoc As Word.Document
Dim WordApp As Word.Application
Dim i As Long, r As Long, c As Long
Dim rng As Range, t As Word.Table
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False
Set WordDoc = WordApp.Documents.Open(DOC_PATH, ReadOnly:=True)
Set sht = Sheets("Sheet4")
Set rng = sht.Range("A20")
sht.Activate
For Each t In WordDoc.Tables
t.Range.Copy
rng.Select
rng.Parent.PasteSpecial Format:="Text", Link:=False, _
DisplayAsIcon:=False
With rng.Resize(t.Rows.Count, t.Columns.Count)
.Cells.UnMerge
.Cells.ColumnWidth = 14
.Cells.RowHeight = 14
.Cells.Font.Size = 10
End With
Set rng = rng.Offset(t.Rows.Count + 2, 0)
Next t
WordDoc.Close
WordApp.Quit
End Sub
I have used the code I found here and tried to extract a PDF file. The code extracts the PDF perfectly in Excel, but I keep getting notification messages. I've disable Display Alerts, but it does not make a difference.
Sub ImportPDF()
Dim objWord As Object
Dim objDoc As Object
Dim wdFileName
Set objWord = CreateObject("word.Application")
wdFileName = "C:\42046_120_2077802.pdf"
Application.DisplayAlerts = False
Set objDoc = GetObject(wdFileName)
objWord.Documents.Open (wdFileName)
objWord.Selection.WholeStory
objWord.Selection.Copy
Sheets(1).Select
[A1].Select
ActiveWorkbook.ActiveSheet.Paste
'objDoc.Close ' I get an error message if I add this (Object does not support this property or method)
objWord.Quit
Application.DisplayAlerts = True
End Sub
The messages I get are the following:
Is there a way to get rid of the messages?
Change your code to:
Sub ImportPDF()
Dim objWord As Object
Dim objDoc As Object
Dim wdFileName
Set objWord = CreateObject("word.Application")
wdFileName = "C:\42046_120_2077802.pdf"
Application.DisplayAlerts = False
Set objDoc = objWord.Documents.Open(wdFileName)
objWord.Selection.WholeStory
objWord.Selection.Copy
Sheets(1).Select
[A1].Select
ActiveWorkbook.ActiveSheet.Paste
objDoc.Close SaveChanges:=False
objWord.Quit
Application.DisplayAlerts = True
End Sub
Application.DisplayAlerts refers to the Excel application, not the instance of Word, which is displaying the alerts.
To avoid the first two alerts, use the additional parameters of Documents.Open
ConfirmConversions - "True to display the Convert File dialog box if the file isn't in Microsoft Word format" - so False.
ReadOnly - "True to open the document as read-only" - so True.
Closing the document without saving changes seems to also avoid the third pop-up. This might be an option as well.
Sub ImportPDF()
Dim objWord As Object, objDoc As Object
Dim wdFileName As String
Set objWord = CreateObject("word.Application")
wdFileName = "C:\42046_120_2077802.pdf"
Set objDoc = objWord.Documents.Open(wdFileName, False, True)
objWord.Selection.WholeStory
objWord.Selection.Copy
ThisWorkbook.Sheets(1).Range("A1").Select
ThisWorkbook.Sheets(1).Paste
objDoc.Close False
objWord.Quit
End Sub
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
I need to have a vb code in ms word 2003 that copy a a specific cell in excel file and paste it in word (filed). Below is what I have done and it result in error.
Sub cmdGetNumber()
Dim XL As Object
Dim WBEx As Object
Dim ExelWS As Object
Dim appwd As Object
Dim wdApp As Word.Application
''''
'On Error GoTo OLE_ERROR
Set XL = CreateObject("Excel.Application")
Set wdApp = CreateObject("Word.Application")
'Open Excel document
Set WBEx = XL.Workbooks.Open("C:\Documents and Settings\121567\Desktop\tafket1.xls")
Set ExelWS = WBEx.Worksheets("Sheet1")
XL.Visible = True
'appwd.Visible = True
ExelWS.Range("c2").Select
'Selection.Copy
'wdApp.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteMetafilePicture
'wdApp.Documents.Save
Set wdApp = Nothing
Set ExelWS = Nothing
Set WBEx = Nothing
End Sub
Since this macro is in Word, you don't need to explicitly open a word instance. You can just do Documents.Add to add a new document, or Documents.Open to open an existing one.
Try this:
Sub cmdGetNumber()
Dim XL As Object
Dim WBEx As Object
Dim ExelWS As Object
Dim wdDoc As Word.Document
'On Error GoTo OLE_ERROR
Set XL = CreateObject("Excel.Application")
'Open Excel document
Set WBEx = XL.Workbooks.Open("C:\Documents and Settings\121567\Desktop\tafket1.xls")
Set ExelWS = WBEx.Worksheets("Sheet1")
'XL.Visible = True
ExelWS.Range("C2").Copy
Set wdDoc = Documents.Add
wdDoc.Activate
wdDoc.Select
Selection.Paste
WBEx.Close
XL.Quit
Set WBEx = Nothing
Set ExelWS = Nothing
Set XL = Nothing
End Sub
The above code will open your excel file, copy the cell C2, then open a new word document, and paste it there.
I see you have mentioned a (filed) in your question. Did you mean a Field or a File? If it is a Field then you may want to replace Selection.Paste with the relevant field name