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.
Related
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.
I'm writing a script where I wish to write an HTML doc to a string from sharepoint.
Dim Content As String
Dim strShare As String: strShare = "\\link\to\share.html"
Dim iFile As Integer: iFile = FreeFile
Open strShare For Input As #iFile
Content = Input(LOF(iFile), iFile)
Close #iFile
However, I find I get a "path/file access error" every time I run the script for the first time upon boot. Once I visit "\link\to\share.html" in IE for the first time, the path begins to resolve in the VBA script.
My only thought is that IE is performing some sort of "DNS Cache" that VBA can't do. Currently my workaround is to catch the error and force the URL to open in IE the first time the script is run. After that, every other HTML file under that share loads fine.
As a test, I tried switching between from what I understand is http:// formatting (forward slash) and WebDAV formatting (\\ formating), and only the backslash separated paths ever work. I also tried to resolve the share to an IP and try it that way, but that never worked.
My last thought is to try mapping the share to a drive letter name and then specifically accessing the share with G:\link\to\mapped\share.html. But I don't see this as an elegant solution, and wonder if it will receive the same error any way.
Is there something blatant that I do not understand about WebDAV, Windows file handling, and VBA file inputs? There's something weird going on under the hood with resolving that shared domain, and I can't seem to debug it.
See if this helps here and an example below that I used.
2 things though: I only worked with Excel files on Sharepoint and I was already logged in there.
Dim oFSO As Object
'Dim oFolder As Object 'if needed
'Dim oFile As Object 'if needed
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("\\sharepoint.site.com#SSL\DavWWWRoot\sites\")
'For Each oFolder In oFolder.SubFolders 'loops through folders
' For Each oFile In oFolder.Files 'loops through files
' 'do stuff
' Next oFile
'Next oFolder
I'm a bit confused about what you want to do. Do you want to check out files from SP and check files back into SP?
Sub testing()
Dim docCheckOut As String
'docCheckOut = "//office.bt.com/sites/Training/Design Admin/Training Plan/adamsmacro.xlsm"
docCheckOut = "http://your_path_here/ExcelList.xlsb"
Call UseCheckOut(docCheckOut)
End Sub
Sub UseCheckOut(docCheckOut As String)
' Determine if workbook can be checked out.
If Workbooks.CanCheckOut(docCheckOut) = True Then
Workbooks.CheckOut docCheckOut
Else
MsgBox "Unable to check out this document at this time."
End If
End Sub
Or...do you want to list files in a SP folder?
Sub ListFiles()
Dim folder As Variant
Dim f As File
Dim fs As New FileSystemObject
Dim RowCtr As Integer
Dim FPath As String
Dim wb As Workbook
RowCtr = 1
FPath = "http://excel-pc:43231/Shared Documents"
For Each f In FPath
'Set folder = fs.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'For Each f In folder.Files
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
Next f
End Sub
Sub test()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'Set colSubfolders = objFolder.SubFolders
'For Each objSubfolder In colSubfolders
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
'Next
End Sub
background
I am running code (from PowerPoint) that:
Loops through every slide in a presentation.
Checks each shape to determine if it is a chart.
If it is a chart, activate the underlying Excel worksheet, and then change the links in this underlying file to a new source.
I note that the links to excel do not exist at the overall PPT level [viaInfo], they are deliberately linked to each chart so that the presentation can be edited without access to the source excel file.
The code works - broadly.
There is an ongoing error (code running fine now) that I think goes to network and memory stability (fails after around 15 charts), and I am looking to turn off screenupdating as per Turn off screenupdating for Powerpoint.
question
All the charts I access are linked to other workbooks. Yet when the Excel workbook is exposed to PowerPoint the Linksources are not shown in the Locals window even though the code processes each link (image below shows the link exists)
I flipped the automation to access the PowerPoint pack from Excel, same result. No Linksources.
Why would the full object model not also be available in the Locals window when automating PowerPoint with Excel?
Is this a localised glitch I have stumbled over, or is it a broader issue?
The picture below shows the code itearying over the links (ppl variable, but the xlWB variable has no Linksources).
code
Sub FastUpdate()
Dim sld As Slide
Dim shp As Shape
Dim pptchrt As Chart
Dim pptChrtData As ChartData
Dim xlWB As Excel.Workbook
Dim lngStart As Long
Dim strNew As String
Dim strMsg As String
Dim ppl As Variant
On Error GoTo cleanup
'set start position manually
'lngStart = 34
If lngStart = 0 Then lngStart = 1
'call custom function for user to pick file
'strNew = Getfile
strNew = "S:\Corporate Model\05 RSM submissions\05 May 2016\02 Checked RSMs\VFAT\Australia\Australia - Valuation and Financial Analysis template.xlsx"
For Each sld In ActivePresentation.Slides
If sld.SlideIndex >= lngStart Then
For Each shp In sld.Shapes
If shp.HasChart Then
Set pptchart = shp.Chart
Set pptChrtData = pptchart.ChartData
'open underlying excel file - doesn't just activate chart
pptChrtData.Activate
'
Set xlWB = pptChrtData.Workbook
'loop through all links
For Each ppl In xlWB.LinkSources
strMsg = strMsg & SlideNumber & " " & pptchart.Name & vbNewLine
xlWB.ChangeLink ppl, strNew
Next
xlWB.Close True
Set xlWB = Nothing
End If
Next shp
End If
Next sld
cleanup:
Set xlWB = Nothing
If Err.Number <> 0 Then MsgBox Err.Description, vbCritical
If Len(strMsg) > 0 Then MsgBox strMsg, vbOKOnly, "Completed"
End Sub
Locals and Watch windows show properties of objects. List of properties of Workbook object can be found here.
LinkSources is a method with optional Type parameter.
If you want to debug LinkSources you can add it to Watch window:
or save return value to local variant variable to see it in Locals window.
I'm writing a macro in Access that (hopefully) will:
create an Excel worksheet
set up and format it based on information in the Access database
after user input, will feed entered data into an existing Excel master file
Opening the blank sheet etc. is working absolutely fine, but I'm stuck trying to set the existing master file up as a variable:
Sub XLData_EnterSurvey()
Dim appXL As Excel.Application
Dim wbXLnew, wbXLcore As Excel.Workbook
Dim wsXL As Excel.Worksheet
Dim wbXLname As String
Set appXL = CreateObject("Excel.Application")
appXL.Visible = True
wbXLname = "G:\[*full reference to file*].xlsm"
IsWBOpen = fnIsWBOpen(wbXLname)
'separate function (Boolean), using 'attempt to open file and lock it' method
'from Microsoft site.
If IsWBOpen = False Then
Set wbXLcore = appXL.Workbooks.Open(wbXLname, True, False)
'open file and set as variable.
ElseIf IsWBOpen = True Then
wbXLcore = appXL.Workbooks("ResultsOverall.xlsm") 'ERROR HERE.
'file is already open, so just set as variable.
End If
Debug.Print wbXLcore.Name
Debug.Print IsWBOpen
Set appXL = Nothing
End Sub
When the file is closed, this works perfectly. However, when it's open I get:
Run-Time error '9':
Subscript out of range
I'm only just starting to teach myself VBA (very trial and error!) and nothing else I've seen in answers here / Google quite seems to fit the problem, so I'm a bit lost...
Considering that it works fine when the file is closed, I suspect I've just made some silly error in referring to the file - perhaps something to do with the 'createobject' bit and different excel instances??
Any suggestions would be much appreciated! Thanks
Thank you #StevenWalker
Here's the working code:
Sub XLData_EnterSurvey()
Dim appXL As Excel.Application
Dim wbXLnew As Excel.Workbook, wbXLcore As Excel.Workbook
Dim wsXL As Excel.Worksheet
On Error GoTo Handler
Set appXL = GetObject(, "Excel.Application")
appXL.Visible = True
Dim wbXLname As String
wbXLname = "G:\ [...] .xlsm"
IsWBOpen = fnIsWBOpen(wbXLname)
If IsWBOpen = False Then
Set wbXLcore = appXL.Workbooks.Open(wbXLname, True, False)
ElseIf IsWBOpen = True Then
Set wbXLcore = appXL.Workbooks("ResultsOverall.xlsm")
End If
Set appXL = Nothing
'-------------------Error handling------------------
Exit Sub
' For if excel is not yet open.
Handler:
Set appXL = CreateObject("Excel.Application")
Err.Clear
Resume Next
End Sub
Sorry I'm on my phone so I can't go in to too much detail or do much with the code but at a glance I think you might need to add an error handler so that if the file is already open, a different line of code is executed.
Add 'On error go to handler' (before creating the excel object) and at the bottom
Of your code add 'handler:'. In the error handler, use get object rather than create object.
You will have to ensure you use exit sub before the error handler or it will run the handler every time you run the code.
You can see an example of what I mean here: How to insert chart or graph into body of Outlook mail
Although please note in this example it's the other way round (if error 'getting' outlook, then create it).
Example in link:
Set myOutlook = GetObject(, "Outlook.Application")
Set myMessage = myOutlook.CreateItem(olMailItem)
rest of code here
Exit Sub
'If Outlook is not open, open it
Handler:
Set myOutlook = CreateObject("Outlook.Application")
Err.Clear
Resume Next
End sub
If you move the appXL.Workbooks statement to the debugging window, you will find that the names of the items in that collection are without extension.
So in your case, I'm guessing the line should read:
wbXLcore = appXL.Workbooks("ResultsOverall")
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.