Write to Word template from Excel crushes on the second run - excel

When I open Workbook and run this code everything is fine. Also if I close Workbook and open it again and run this code everything if functioning. However if I open Workbook and try to run this code for the second time then all Word operations are crushing. Word template is opened by code and even is saved to needed destination but it is not able to close Word document and gives an error:
Is there some variable or something in Windows memory still present after code has been executed because after closing and reopening Workbook everything works fine. Any ideas how to fix this?
Sub opentemplateWordOL()
Dim sh As Shape
Dim objWord As Object, objNewDoc As Object ''Word.Document
Dim objOL As OLEObject
Dim wSystem As Worksheet
'Application.ScreenUpdating = False
Set wSystem = ThisWorkbook.Sheets("Templates")
''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = wSystem.Shapes("OfferLetterTemplate")
''The OLE Object contained
Set objOL = sh.OLEFormat.Object
'Instead of activating in-place, open in Word
objOL.Verb xlOpen
'Set objWord = objOL.Object 'The Word document
Set objNewDoc = objOL.Object
Set objWord = objNewDoc.Application
Dim objUndo As Object 'Word.UndoRecord
'Be able to undo all editing performed by the macro in one step
Set objUndo = objWord.UndoRecord
objUndo.StartCustomRecord "Edit In Word"
With objNewDoc
'Cover page
.Bookmarks("CoverPageTitle").Range.Text = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
objNewDoc.SaveAs2 Environ$("Temp") & "\" & _
"MyFile" & ".docx"
objUndo.EndCustomRecord
objNewDoc.Undo
.Application.Quit False
End With
Set objWord = Nothing
Set objUndo = Nothing
Set sh = Nothing
Set wSystem = Nothing
Set objNewDoc = Nothing
'Application.ScreenUpdating = True
End Sub
You can check how this behaves on my computer here: https://streamable.com/2xd8k
You can see (by time of creation of file) that it is getting overwritten every time even when there is an error.

Related

VBA Closing a word document which has already been opened using another sub, bad file name error

I've set up code that opens a word document and closes excel, from the word document there is code to reopen excel and copy user data to a new sheet which I pull from for a form. This whole process works perfectly, the issue is trying to close the word document once I've finished my tasks.
I want to close the word document once I'm back in excel however everything I'm trying returns bad file name error when I try to reference the doc. I know for a fact that the file path is correct. I also know that you cant reference the open doc the normal way you would. I've substituted the variable filePath for privacy reasons.
Here is the code from word which is executed first
Sub sendTableToExcel()
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim ws As Worksheet
Dim doc As Document
Dim tbl As Table
Set doc = ThisDocument
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWb = xlApp.Workbooks.Open(filePath)
Set ws = Sheets.Add
ws.Name = "temp"
Set tbl = doc.Tables(1)
tbl.Range.Copy
xlWb.Worksheets(ws.Name).PasteSpecial wdPasteText
ws.Visible = False
xlWb.Application.Run "pasteCopiedValuesFromRequestDocs"
xlWb.Application.Run "openRequestLanding", "Casual" //this is the where I'm trying to close the doc
Set xlWb = Nothing
Set xlApp = Nothing
Set tblRange = Nothing
Set tbl = Nothing
Set doc = Nothing
End Sub
and the sub from excel which is called from word
Public Sub openRequestLanding(requestType As String)
Dim wdApp As Word.Application
Dim doc As Word.Document
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set doc = wdApp.Documents(filePath)
doc.Close SaveChanges:=wdDoNotSaveChanges
Set wdApp = Nothing
Set doc = Nothing
RequestLanding.RequestTypeBox.Value = requestType
RequestLanding.Show
End Sub
You will have no success in closing the document as it is not open in the instance of Word that your code references. Your code in Excel needs to get the currently open instance of Word, not create a new one.
Change
Set wdApp = CreateObject("Word.Application")
to
Set wdApp = GetObject(, "Word.Application")

Setting range in Word with VBA in Excel

How do I set a range in Word while opening that file with VBA in Excel?
Dim wordApp As Word.Application
Dim wordObject As Word.Document
Dim wordRange As Word.Range
Dim filePath As String
Dim fileName As String
filePath = "C:\Users\"
fileName = "somename.docx"
Set wordApp = CreateObject("Word.Application")
With wordApp
.Visible = True
.Activate
.WindowState = wdWindowStateNormal
End With
Set wordObject = wordApp.Documents.Open(filePath & fileName)
Set wordRange = Documents(fileName).Sections(1).Range
With wordRange
'code
End With
The line causing trouble:
Set wordRange = Documents(fileName).Sections(1).Range
Regardless of the string I put in this returns
4160 runtime error "Bad File Name"
If I use ActiveDocument instead of Documents(), I get
4248 runtime error: "This command is not available because no document is open".
The error persists even after opening multiple unsaved and saved Word docs whilst running the code, only to have the same error message show up.
Set wordRange = Documents(fileName).Sections(1).Range errors because Excel doesn't know what Documents is (or it resolves it to something other than Word.Documents)
To fix that, you'd use (just as you did in the previous line)
Set wordRange = wordApp.Documents(fileName).Sections(1).Range
That said, you've already Set the Document(filepath & filename) to wordObject, so use it:
Set wordRange = wordObject.Sections(1).Range
Also, Excel doesn't know wdWindowStateNormal, so a new Variant variable is created (unless you have Option Explicit, which you should, always) and assigned the default value 0. Which just happens to be the value of Word.wdWindowStateNormal so no harm done, but the code is misleading.
To fix, use
.WindowState = 0 'wdWindowStateNormal
I'm curious about the way you've created the object. Using early binding but instead of creating New Word.Application you use CreateObject
Was this an intentional decision?
What is the benefit?

Closing ChartData Window of a Word Document

I have code that opens a Word document and goes through the charts, updating the data.
The problem is that I call this macro multiple times in a row. Even though I close the Word application, the chartdata window remains open.
Excel is crashing without telling me why but E think the problem is with the chartdata windows not being closed. Because if I run the macro only one time, it works.
But, how do I close the chartdata window if the chart doesn't support this property?
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdShape As InlineShape
Dim wdChart As Word.Chart
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
'Opening the document
Set wdDoc = wdApp.Documents.Open("path_here")
'Opening the chartdata window
Set wdShape = wdDoc.InlineShapes(1)
Set wdChart = wdShape.Chart
wdChart.ChartData.Activate
'Changing the data
Range("B2").Value = 120
Range("B3").Value = 155
'Closing the app
wdApp.Quit SaveChanges:=wdSaveChanges
Set wdShape = Nothing
Set wdChart = Nothing
Set wdApp = Nothing
Set wdDoc = Nothing
This code will change the values in the data without activating the chartdata window. For some reason the wdChart variable was throwing a constant assignment error, so I changed it to wdCh.
Set wdShape = wdDoc.InlineShapes(1)
Set wdCh = wdShape.Chart
With wdCh.ChartData.Workbook.Sheets(1)
.Range("B2").Value = 120
.Range("B3").Value = 155
End With

Loop not opening PDFs...so copy/Paste to Excel fails (I think)

Apologies in advance for the length of this post, but I wanted to describe my issues in detail in the hopes one of you VBA masters can assist
Goal
Loop through all PDFs in a folder
For each PDF:select all/copy/paste into Excel
Call a separate macro to convert the pasted data into something
legible.
Background
The below sub [CopyPDFtoExcel()] worked yesterday but is now failing on the ActiveSheet.Paste line with the
"Runtime error '1004' Paste method of Worksheet class failed".
If I step though (via F8), it appears to NOT be actually opening the PDF, and therefor is unable to select all/copy/paste, producing the Runtime error. However, I do not get an error dialog, which I would think I would get (from the Debug.Assert False) if it can't find the file.
My fName's are defined as variable via a named range called path2008. These file paths were derived by running PullFilePathsforPDFs(), which spits out the full file path for each PDF in my folder. Then, I have selected those file paths and given it a name, in this case path2008, which is for 13 different PDFs. NOTE: There are actually 250+ PDFs in this folder but I selected a subset for testing, hence the 13 associated with path2008.
What I have done so far
Tested the file path for each PDF in the path2008 range by using the
(cumbersome non-looping) ActiveWorkbook.FollowHyperlink method,
which successfully opens all the PDFs. So, I'm pretty confident the
file paths are correct.
'ActiveWorkbook.FollowHyperlink "file path here"
Stripped out the select all/copy/paste VBA code, leaving just the
loop [See the sub TroubleshootingOpeningPDFLoop()]. When I step
through the FIRST time the yellow line goes from the Set oPDDoc =
oAVDoc.GetPDDoc line to the End If....presumabley meaning it found a
file during the first loop (though I do not see the PDF open). On
the SECOND (and all subsequent loops) it goes to Else then
Debug.Assert False (but no error dialog appears).
Restarted Excel and Acrobat, same issue
Restarted computer, same issue
Recreated a new workbook, same issue
Main code
Sub CopyPDFtoExcel()
Dim fName As Variant
Dim wbPayroll As Excel.Workbook
Dim wsConvert As Excel.Worksheet
Dim oPDFApp As AcroApp
Dim oAVDoc As AcroAVDoc
Dim oPDDoc As AcroPDDoc
Set wbPayroll = Workbooks("Payroll.xlsm")
Set wsConvert= wbPayroll.Sheets("Convert")
Set oPDFApp = CreateObject("AcroExch.App")
Set oAVDoc = CreateObject("AcroExch.AVDoc")
Set oPDDoc = CreateObject("AcroExch.PDDoc")
'Open the PDF file. The AcroAVDoc.Open function returns a true/false
For Each fName In Range("path2008")
If oAVDoc.Open(fName.Text, "") = True Then
Set oPDDoc = oAVDoc.GetPDDoc
Else
Debug.Assert False
End If
'Copy all using Acrobat menu
oPDFApp.MenuItemExecute ("SelectAll")
oPDFApp.MenuItemExecute ("Copy")
'Paste into Convert sheet
wbPayroll.Activate
wsConvert.Cells(1, 1).Select
ActiveSheet.Paste 'It worked yesterday, but now error on this line with below error
'Runtime error '1004' Paste method of Worksheet class failed
oAVDoc.Close (1) '(1)=Do not save changes
'oPDDoc.Close
Call ConversionMacro
Next
'Clean up
Set wbTransfer = Nothing
Set wsNew = Nothing
Set oPDFApp = Nothing
Set oAVDoc = Nothing
Set oPDDoc = Nothing
End Sub
My effort to isolate the PDF open failure problem
Sub TroubleshootingOpeningPDFLoop()
Dim fName As Variant
Dim wbPayroll As Excel.Workbook
Dim wsConvert As Excel.Worksheet
Dim oPDFApp As AcroApp
Dim oAVDoc As AcroAVDoc
Dim oPDDoc As AcroPDDoc
'Define your spreadsheet
Set wbPayroll = Workbooks("Payroll.xlsm")
Set wsConvert= wbPayroll.Sheets("Convert")
'Instantiate Acrobat Objects
Set oPDFApp = CreateObject("AcroExch.App")
Set oAVDoc = CreateObject("AcroExch.AVDoc")
Set oPDDoc = CreateObject("AcroExch.PDDoc")
'Open the PDF file. The AcroAVDoc.Open function returns a true/false
For Each fName In Range("path2008")
If oAVDoc.Open(fName.Text, "") = True Then
Set oPDDoc = oAVDoc.GetPDDoc
Else
Debug.Assert False
End If
Next
End Sub
Sub used to pull the file paths
Sub PullFilePathsforPDFs()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:\Stuff\MoreStuff") 'all PDFs I need are stored here
i = 1
For Each objFile In objFolder.Files
Cells(i + 1, 1) = objFile.Name
Cells(i + 1, 2) = objFile.Path
i = i + 1
Next objFile
End Sub
I am having cut/copy - paste troubles lately (runtime error 1004)
Using the latest Excel but also working on "ancient" applications.
What did the trick for me was working with the original "given" name
(Sheet1,Sheet2 etc. As soon as I added/renamed the same sheets, the runtime errors came back.
If you want to make sure to generate an error when the opening operation does not succeed, I would add the following at the end of TroubleshootingOpeningPDFLoop:
If oPDDoc is nothing then
Debug.Assert False
End If
If this doesn't return an error, that means that the file is open in the application, but that it is not visible. It could be caused by the fact that you are using a PDDoc instead of an AVDoc. So, switching the 2 might allow you to see it when debugging.
As of your main problem, it might be due to the fact that Acrobat does not process the commands fast enough and you need to include some waiting time in your code to let Acrobat enough time to process the command. For example, you could have:
'Copy all using Acrobat menu
oPDFApp.MenuItemExecute ("SelectAll")
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1)
oPDFApp.MenuItemExecute ("Copy")
Which will make VBA wait one second before running the next command.

I can't close the Excel application

I have this code I wrote in VBScript for wincc, and after running it the Excel application is still running, and the project is not working properly after this script. What can I do to close the Excel app?
Here is the script:
Dim fso
Dim rowcount
Dim ExcelObject
Dim WorkbookObject
Dim file
Dim i
Dim tg
Dim objSheet1
Dim objSheet2
'Set Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ExcelObject = CreateObject("Excel.Application")
file="C:\Parametri\Codificari.xls"
Set WorkbookObject = ExcelObject.Workbooks.Open(file)
'Set objSheet1 = WorkbookObject.Worksheets(1)
Set objSheet2 = WorkbookObject.Worksheets(2)
objSheet2.Cells(1,1)=SmartTags("locatie_defect")
If (fso.FileExists(file)) Then
'Raw numbering in Excel
rowcount = objSheet2.UsedRange.Rows.count
For i=3 To rowcount
tg="defect_"&i-2
SmartTags(tg)=objSheet2.Cells(i,2)
Next
End If
On Error Resume Next
'Save and close excel
ExcelObject.DisplayAlerts = False
ExcelObject.Workbooks.Close False
ExcelObject.Workbooks.Save
ExcelObject.Quit
On Error Resume Next
The standard way to close (sans error handling)
WorkbookObject.Save
WorkbookObject.Close False
ExcelObject.Quit
Set WorkbookObject= Nothing
Set ExcelObject = Nothing
Ensure all references are fully qualified, see here. On a quick look-over this doesnt jump out from your code.
For some reason Excel doesn't follow COM rules when used as an app object. No doubt for some compatibility reason.
It does follow COM rules as a doc object.
So Set WorkbookObject = GetObject("C:\Parametri\Codificari.xls") and now when it goes out of scope it will close as long as it's not visible. So just save it and it will close when your script ends. You probably only need half the lines you have.

Resources