Im attempting to connect Adobe Acrobat to Excel Via VBA. The Goal is to take a PDF and insert it into Excel.
Sub Imp_Into_XL(PDF_File As String, Each_Sheet As Boolean)
'This procedure get the PDF data into excel by following way
'1.Open PDF file
'2.Looping through pages
'3.get the each PDF page data into individual _
sheets or single sheet as defined in Each_Sheet Parameter
Dim AC_PD As Acrobat.AcroPDDoc 'access pdf file
Dim AC_Hi As Acrobat.AcroHiliteList 'set selection word count
Dim AC_PG As Acrobat.AcroPDPage 'get the particular page
Dim AC_PGTxt As Acrobat.AcroPDTextSelect 'get the text of selection area
Dim WS_PDF As Worksheet
Dim RW_Ct As Long 'row count
Dim Col_Num As Integer 'column count
Dim Li_Row As Long 'Maximum rows limit for one column
Dim Yes_Fir As Boolean 'to identify beginning of page
Li_Row = Rows.Count
Dim Ct_Page As Long 'count pages in pdf file
Dim i As Long, j As Long, k As Long 'looping variables
Dim T_Str As String
Dim Hld_Txt As Variant 'get PDF total text into array
RW_Ct = 0 'set the intial value
Col_Num = 1 'set the intial value
Application.ScreenUpdating = False
Set AC_PD = New Acrobat.AcroPDDoc 'ERROR LINE HERE
Set AC_Hi = New Acrobat.AcroHiliteList
I get an Runtime Error 429: ActiveX Component Can't Create Object on the line with Set AC_PD = New Acrobat.AcroPDDoc. I'm not sure what's causing it. I'm pretty sure I have all the correct references. Any and all help appreciated!
The answer for anyone that comes across this is to buy Adobe Acrobat Pro. Runs perfectly with it since you can only get the exact right references with Pro.
Related
My program has output data to the Listview control. Now I would like to export the data to a text file/excel and then load it back to the listview control when I need to. I know how to do both these tasks using the listbox control but listview is new to me. I've been researching and playing around with code for hours but I keep getting one error or the other. Kindly find the latest version of my code to export data below. Also, if you could provide code to import, that would be super.
'Export the listview to an Excel spreadsheet
Dim SaveFileDialog1 As New SaveFileDialog
SaveFileDialog1.Title = "Save Excel File"
SaveFileDialog1.Filter = "Excel files (*.xls)|*.xls|Excel Files
(*.xlsx)|*.xslx"
SaveFileDialog1.ShowDialog()
'exit if no file selected
If SaveFileDialog1.FileName = "" Then
Exit Sub
End If
'create objects to interface to Excel
Dim xls As New Excel.Application
Dim book As Excel.Workbook
Dim sheet As Excel.Worksheet
Dim placeholder As String
'create a workbook and get reference to first worksheet
xls.Workbooks.Add()
book = xls.ActiveWorkbook
sheet = book.ActiveSheet
'step through rows and columns and copy data to worksheet
Dim row As Integer = 1
Dim col As Integer = 1
For Each item As ListViewItem In lstViewUsers.Items
For i As Integer = 0 To item.SubItems.Count - 1
placeholder = sheet.Cells(row, col) = item.SubItems(i).Text
col = col + 1
Next
row += 1
I want to see if the value in column A of one workbook is in column A of another workbook (and then return the row). However, I'm stuck at using match.
I tried different approaches with the match function, first with a reference, then I simply typed in a number to match. The problem is: As long as the current workbook (wbCurr) is open, it always looks for the value there. When I close it, it looks in the master file (wbMaster) which is what I want.
Sub ReportCreation()
Dim wbMaster As Workbook, wbCurr As Workbook As Workbook
Dim pathMaster As String, pathCurrent As String As String
Dim rowMaster As Variant
Dim rowCurrent As Long, lRowCurrent As Long, lRowMaster As Long
pathMaster = "C:\Users\VBA\report2019.xlsx"
pathCurrent = "C:\Users\VBA\report 042019.xlsx"
Set wbMaster = Workbooks.Open(pathMaster)
Set wbCurr = Workbooks.Open(pathCurrent) 'current month
' rowMaster = Application.Match(wbCurr.Worksheets(1).Cells(3, 1), wbMaster.Worksheets(1).Range("A:A"), 0)
rowMaster = Application.WorksheetFunction.Match(7, wbMaster.Worksheets(1).Range("A:A"), 0)
Debug.Print rowMaster
End Sub
I wanna do a simple search and replace in powerpoint.
I am trying to loop through an excel spreadsheet using a VBA-macro in powerpoint.
The spreadsheet has two columns and ~100 rows. I want the macro to loop through the rows until it reaches an empty cell.
For each row it shell read the values of column 1 and column 2 and write those to an 2-dimensional-array.
I had it running using various .select-statements but I didn't like it that way (is select buggy? Search and replace worked a few times, but after changing the spreadsheet too often the macro always crashed).
I am trying to use a more robust way with better performance.
Dim excelDataArray(120, 2) As String
Dim slidedeck As Presentation
Set slidedeck = ActivePresentation
Dim singleslide As Slide
Dim excelFile As Excel.Workbook
Set excelFile = Excel.Application.Workbooks.Open(spreadsheetFolder)
Dim excelSheet As Excel.Worksheet
Set excelSheet = excelFile.Worksheets("Sheet1")
'Loop through each row in Column A until empty row
Dim N As Integer
N = excelSheet.Cells(excelSheet.Rows.Count, "A").End(xlUp).Row
For i = 1 To N
excelDataArray(i, 0) = excelSheet.Cells(i, "A").Value
excelDataArray(i, 1) = excelSheet.Cells(i, "B").Value
Next
You can dump it directly to a variant array without loops.
I have tidied your variables for completeness.
Pls change the path to your xl file here, "C:\temp\test.xlsx"
Sub likethis()
Dim slidedeck As Presentation
Dim singleslide As Slide
Dim XLS As Excel.Application
Dim excelFile As Excel.Workbook
Dim excelSheet As Excel.Worksheet
Dim lngROw As Long
Dim X
Set slidedeck = ActivePresentation
Set XLS = New Excel.Application
Set excelFile = XLS.Workbooks.Open("C:\temp\test.xlsx")
Set excelSheet = excelFile.Worksheets("Sheet1")
lngROw = excelSheet.Cells(excelSheet.Rows.Count, "A").End(xlUp).Row
ReDim X(1 To lngROw, 1 To 2)
X = excelSheet.Range("A1:B" & lngROw)
End Sub
I have a button in Access (2003) that transfers data to Excel (also 2003). It opens the Excel workbook, then cycles through the Access subforms and transfers data.
To give more information on how this works, Excel has a range called "Tables" which contains the names of the Access subforms ("Main", "Demographics", "History", etc). Excel also has a range for each of the names in that first range. For example, the range "Demographics" contains a series of field names ("FirstName", "LastName", etc). So the first loop moves through the subforms, and the nested loop moves through the field names. Each field then passes the value in it over to excel. Excel also has ranges for "Demographics_Anchor" and "History_Anchor" etc, which is the first value in the column next to each range (ie the range Demographics has firstname, lastname, and to the right is where the data would go. So the first item in the range is FirstName, to the right "Demographics_Anchor" is where firstname will go. Then LastName goes to Demographics_Anchor offset by 1 - or 1 cell down from the anchor).
Dim ThisForm As Form
Dim CForm As Object
Dim CTab As TabControl
Dim CControl As Control
Dim CurrentTab As Variant
Dim CControlName As Variant
Dim CControlValue As String
Dim Code As Control
Dim counter1 As Integer
Dim appExcel As Object
Dim Anchor As Object
Dim PageRange As Object
Dim ControlNameRange As Object
strpath = "C:\blah\blah\filename.xlsm"
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open Filename:=strpath, UpdateLinks:=1, ReadOnly:=True
Set wbk = appExcel.ActiveWorkbook
Set PageRange = appExcel.Range("Tables")
'set Access environment
Set ThisForm = Forms("frmHome")
Set CTab = ThisForm.Controls("Subforms")
'export the data from Access Forms to Excel
For Each CurrentTab In PageRange
If CurrentTab = "Main" Then
Set CForm = ThisForm
Else
CTab.Pages(CurrentTab).SetFocus
Set CForm = ThisForm.Controls(CurrentTab & " Subform").Form
End If
Set ControlNameRange = appExcel.Range(CurrentTab)
Set Anchor = appExcel.Range(CurrentTab & "_Anchor")
counter1 = 0
For Each CControlName In ControlNameRange
Set CControl = CForm.Controls(CControlName)
CControl.SetFocus
Anchor.Offset(RowOffset:=counter1).Value = CControl.Value
counter1 = counter1 + 1
Next CControlName
Next CurrentTab
I hope this explains what is going on in the code. I just can't figure out why this keeps bombing out with type mistmatch (error 13).
The data DOES transfer. It goes through the entire code and every piece of data correctly gets transferred over. It bombs out at the end as if it goes through the code 1 last time when it shouldn't. I did confirm that every range is correct and doesn't contain any null values. The code bombs out on this line: Set CControl = CForm.Controls(CControlName) which is towards the bottom of the second loop.
Please help! I've spent weeks working with this code and had no luck. This exact code works in every other database I've worked with.
You are getting the name of the control CControlName from your Excel Range, but then setting the value of this control to the control on the Access form Set CControl = CForm.Controls(CControlName). From this, the most likely explanation is probably that the CControlName isn't actually on the Access form (perhaps a typo?).
In the VBA IDE, go under the Tools Menu, select Options and then select the General tab. Under the Error Trapping section, select the "Break on All Errors" option and click "OK" to set the preference. Run your code again; when an error is encountered VBA will stop processing on the line that caused the error. Check the value of CControlName and make sure it actually exists on the Access form.
How do I copy an email to the clipboard and then paste it into excel with the tables intact?
I am using Outlook 2007 and I want to do the equivalent of
"Click on email > Select All > Copy > Switch to Excel > Select Cell > Paste".
I have the Excel Object Model pretty well figured out, but have no experience in Outlook other than the following code.
Dim mapi As NameSpace
Dim msg As Outlook.MailItem
Set mapi = Outlook.Application.GetNamespace("MAPI")
Set msg = mapi.Folders.Item(1).Folders.Item("Posteingang").Folders.Item(1).Folders.Item(7).Items.Item(526)
I must admit I use this in Outlook 2003, but please see if it works in 2007 as well:
you can use the MSForms.DataObject to exchange data with the clipboard. In Outlook VBA, create a reference to "Microsoft Forms 2.0 Object Library", and try this code (you can of course attach the Sub() to a button, etc.):
Sub Test()
Dim M As MailItem, Buf As MSForms.DataObject
Set M = ActiveExplorer().Selection.Item(1)
Set Buf = New MSForms.DataObject
Buf.SetText M.HTMLBody
Buf.PutInClipboard
End Sub
After that, switch to Excel and press Ctrl-V - there we go!
If you also want to find the currently running Excel Application and automate even this, let me know.
There's always a valid HTMLBody, even when the mail was sent in Plain Text or RTF, and Excel will display all text attributes conveyed within HTMLBody incl. columns, colors, fonts, hyperlinks, indents etc. However, embedded images are not copied.
This code demonstrates the essentials, but doesn't check if really a MailItem is selected. This would require more coding, if you want to make it work for calendar entries, contacts, etc. as well.
It's enough if you have selected the mail in the list view, you don't even need to open it.
I finally picked it up again and completely automated it. Here are the basics of what I did to automate it.
Dim appExcel As Excel.Application
Dim Buf As MSForms.DataObject
Dim Shape As Excel.Shape
Dim mitm As MailItem
Dim itm As Object
Dim rws As Excel.Worksheet
'code to open excel
Set appExcel = VBA.GetObject(, "Excel.Application")
'...
'code to loop through emails here
Set mitm = itm
body = Replace(mitm.HTMLBody, "http://example.com/images/logo.jpg", "")
Call Buf.SetText(body)
Call Buf.PutInClipboard
Call rws.Cells(i, 1).PasteSpecial
For Each Shape In rws.Shapes
Shape.Delete 'this deletes the empty shapes
Next Shape
'next itm
I removed the logo urls to save time, and when you're dealing with 300 emails, that translates into at least ten minutes saved.
I got the code I needed from a TechRepublic article, and then changed it to suit my needs. Many thanks to the accepted answerer of this question for the clipboard code.
Ok so I will have to make certain assumptions because there is information missing from your question.
Firstly you didn't say what mailformat the message is... HTML would be the easiest, the process will be different for RTF and not possible in plaintext
Since you are refering to tables I will assume they are HTML tables and the mail format is HTML.
Also it is not clear from your question if you want the table content pasted seperately (1 excel cell per table cell) and the rest of the emails bodytext pasted into 1 cell or several?
finally you haven't really said if you want the VBA running from Outlook or Excel (not that important but it affects which intrinsic objects are available.
Anyway code sample:
Outlook code to access the htmlbody prop
Dim mapi As Namespace
Set mapi = Application.Session
Dim msg As MailItem
Set msg = mapi.Folders.Item(1).Folders.Item("Posteingang").Folders.Item(1).Folders.Item(7).Items.Item(526)
Dim strHTML as String
strHTML = msg.HTMLBody
' There is no object model collection for html tables within the htmlbody (which is a string of html) you will need to parse the html and collect the tables before inserting into Excel.
After a while again, I found another way. MailItem.Body is plain text, and has a tab character between table cells. So I used that. Here is the gist of what I did:
Sub Import()
Dim itms As Outlook.Items
Dim itm As Object
Dim i As Long, j As Long
Dim body As String
Dim mitm As Outlook.MailItem
For Each itm In itms
Set mitm = itm
ParseReports (mitm.body) 'uses the global var k
Next itm
End Sub
Sub ParseReports(text As String)
Dim table(1 To 1000, 1 To 11) As String 'I'm not expecting to see a thousand rows!
Dim drow(1 To 11) As String
For Each Row In VBA.Split(text, vbCrLf)
j = 1
For Each Col In VBA.Split(Row, vbTab)
table(i, j) = Col
j = j + 1
Next Col
i = i + 1
Next Row
For i = 1 To l
For j = 1 To 11
drow(j) = table(i, j)
Next j
hws.Range(hws.Cells(k, 1), hws.Cells(k, 11)) = drow
k = k + 1
Next i
End Sub
Average: 77 emails processed per second. I do some minor processing and extracting.