I've been searching for an answer to this particular issue but I can't seem to find one. I am trying to combine multiple Excel-based lists that I receive as e-mail attachments. Just to give a little context, this macro has been working for almost two years without error but I recently switched it from a system running Excel 2007 & Outlook 2010 to a system running Excel 2007 & Outlook 2007.
The following line is giving me an 1004: Application-defined or object-defined error:
LR = xlAtt.ActiveSheet.Range("A" & xlAtt.ActiveSheet.Rows.Count).End(xlUp).Row
in context the code is:
Private Sub ProcessAttachments(olFolder As Outlook.MAPIFolder)
Dim xlApp As Object, xlAtt As Object
Dim LR As Long
Dim olItem As Outlook.MailItem
Dim count As Integer
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
For count = olFolder.Items.Count To 1 Step -1
Set olItem = olFolder.Items.Item(count)
If olItem.Class = olMail And olItem.Attachments.Count > 0 Then
'Omitted a few lines here that verify if the attachment is an Excel file
'and then saves it to a folder
Set xlAtt = xlApp.Workbooks.Open("pathToFile")
xlAtt.Activate
LR = xlAtt.ActiveSheet.Range("A" & xlAtt.ActiveSheet.Rows.Count).End(xlUp).Row
'More VBA after
The above is just a snippet of the code but hopefully gives enough context.
I have tried testing each individual piece of the line giving me an error and I've been able to narrow it down to the .End(xlUp).Row portion of the line.
Any help is appreciated.
Outlook 2007 must not recognize the Excel Constants, whereas OL 2010 does.
Instead of writing xlUp write the enumeration for xlUp which is -4162.
So your code would look like this:
LR = xlAtt.ActiveSheet.Range("A" & xlAtt.ActiveSheet.Rows.Count).End(-4162).Row
To find any enumeration for any constant in Excel VBA, once inside the VBE, press F2 to open the Object Browser and type the constant into the box next to the binoculars, then click the binocular. Click on the constant in the search results and the box at the bottom will show the enumeration.
Alternatively, you could set a constant variable to the enumeration and still use xlUp in your syntax by:
Constant xlUp = -4162
Related
This question is related with a previous one.
I have an open Word document with a bunch of bookmarks, each with an inline image of an Excel table previously exported from Excel.
Now, I need to update the tables in the Word document as they have changed in Excel.
The way I'm doing this is matching the table names in Excel with the bookmark names in Word. If they are equal than I want to replace the existing images in Word by the current ones.
This is my code so far:
Option Explicit
Sub substituir()
Dim Mark As String
Dim Rng As Range
Dim ShpRng As Range
Dim WordApp As Object
Dim DocumentoDestino As Object
Dim folha As Worksheet
Dim tabela As ListObject
Dim nomeTabela As String
Set WordApp = GetObject(class:="Word.Application")
Set DocumentoDestino = WordApp.ActiveDocument
For Each folha In ThisWorkbook.Worksheets
If folha.Visible Then
'loop all excel tables
For Each tabela In folha.ListObjects
tabela.Name = Replace(tabela.Name, " ", "")
Mark = CStr(tabela.Name)
With ActiveDocument
If .Bookmarks.Exists(Mark) Then
Set Rng = .Bookmarks(Mark).Range ' returns runtime error 13: Type mismatch, I guess it is because .Bookmarks expects the bookmark index instead of the name.
If Rng.InlineShapes.Count Then
Set ShpRng = Rng.InlineShapes(1).Range
With ShpRng
Debug.Print .Start, .End
ShpRng.Delete
End With
End If
End If
End With
Next tabela
End If
Next folha
End Sub
The code seems ok, except for the line marked above that returns runtime error 13, is there any way to get to the bookmark index instead of the name or another way to fix the issue?
Thanks in advance!
The problem is from the Range object. There is such an object in Excel as well as in Word. Since you are running Excel, both Rng and ShpRng are declared as Excel ranges implicitly. Declare them as Word.Range.
Quite generally, be more careful with your use of variables. You perfectly declared Set DocumentoDestino = WordApp.ActiveDocument, but then you proceed with
With ActiveDocument
If .Bookmarks.Exists(Mark) Then
In Excel, there is no ActiveDocument. Perhaps that is why Excel correctly divines your intention to refer to DocumentoDestino. However, if you don't keep tight control instances are likely to arise - whenever you least expect them, of course - when Excel makes the wrong guess.
I am trying to create an Outlook Appointment with a Macro, I am having an issue with the code giving me an error of "Object Doesn't support this property or method" when it comes the Default Appointment Values. I have tried several fixes but am not experienced enough to resolve. Any assistance is greatly appreciated.
Here is what I am working with:
Sub CalendarInvite()
Dim olApp As Object
Dim olAppItem As Object
Dim r As Long
Set olApp = GetObject("", "Outlook.Application")
Dim mysub, myStart, myEnd
mysub = Range("Title")
myStart = Range("Date")
myEnd = Range("Date")
'creates a new appointment
Set olAppItem = olApp.CreateItem(olAppointmentItem)
'set default appointment values
With olAppItem
.Location = Range("Location")
.Body = Range("Body")
.ReminderSet = True
.BusyStatus = olFree
.RequiredAttendees = "email#email.com"
'saves the new appointment to the default folder
.Save
End With
Set olAppItem = Nothing
Set olApp = Nothing
End Sub
Set olAppItem = olApp.CreateItem(olAppointmentItem)
Assuming you're late-binding the Outlook library, the constant olAppointmentItem is not defined, so if you specify Option Explicit at the top of the module the VBE will highlight if as undeclared.
I copied your code into ThisWorkbook in an empty workbook, and ran Rubberduck code inspections (disclaimer: I manage that open-source project; it's completely free, and it's improving every day).
These results are particularly relevant to your problem:
Error: Option Explicit is not specified in 'ThisWorkbook' - (Book3) VBAProject.ThisWorkbook, line 1
Error: Variable 'olAppointmentItem' is used but not assigned - (Book3) VBAProject.ThisWorkbook, line 16
Error: Variable 'olFree' is used but not assigned - (Book3) VBAProject.ThisWorkbook, line 23
Error: Local variable 'olAppointmentItem' is not declared - (Book3) VBAProject.ThisWorkbook, line 16
Error: Local variable 'olFree' is not declared - (Book3) VBAProject.ThisWorkbook, line 23
The underlying value of olFree in the Outlook library is 0, so that's not a big deal as far as run-time errors are concerned.
However olAppointmentItem not being defined is pretty big: you think you're working against an AppointmentItem object, but because the underlying value of olAppointmentItem in the Outlook library is 1 and you're providing a 0, the runtime type of olAppItem is actually a MailItem.
And because a MailItem doesn't have a Location property, attempting to set it will raise that run-time error 438 you're getting - "object doesn't support this property or method".
Therefore, you should be creating the olAppItem like this:
Set olAppItem = olApp.CreateItem(1)
Or, define the olAppointmentItem constant:
Const olAppointmentItem As Long = 1
Set olAppItem = olApp.CreateItem(olAppointmentItem)
Or, reference the Outlook object model (Tools > References...), replace As Object with the actual types you want to be using (olApp As Outlook.Application, olAppItem As AppointmentItem), and then the olAppointmentItem and olFree constants will be taken from the Outlook library.
I'll skip the other inspection results because they're not relevant to that specific question, but you'll notice a number of dead variables there.
If you want to create an appointment in Outlook, using Excel, run the script below.
Private Sub Add_Appointments_To_Outlook_Calendar()
'Include Microsoft Outlook nn.nn Object Library from Tools -> References
Dim oAppt As AppointmentItem
Dim Remind_Time As Double
i = 2
Subj = ThisWorkbook.Sheets(1).Cells(i, 1)
'Loop through entire list of Reminders to be added
While Subj <> ""
Set oAppt = Outlook.Application.CreateItem(olAppointmentItem)
oAppt.Subject = Subj
oAppt.Location = ThisWorkbook.Sheets(1).Cells(i, 2)
oAppt.Start = ThisWorkbook.Sheets(1).Cells(i, 3)
Remind_Time = ThisWorkbook.Sheets(1).Cells(i, 4) * 1 * 60
oAppt.ReminderMinutesBeforeStart = Remind_Time
oAppt.AllDayEvent = True
oAppt.Save
i = i + 1
Subj = ThisWorkbook.Sheets(1).Cells(i, 1)
Wend
MsgBox "Reminder(s) Added To Outlook Calendar"
End Sub
' The code comes from this link:
http://officetricks.com/add-appointment-to-outlook-calendar-through-excel-macro-vba/
The script is run from Excel, and as such, you must set a reference to Outlook before you run the code. Also, notice that the worksheet needs to be setup properly for the script to run. It should look something like this. Everything is read from Excel into Outlook.
Excel 2010 & SSIS 2012 - when Outlook is open and the macro is ran I get an Run-time error 429 - ActiveX couldn't create object...when Outlook is closed the macro performs as expected - it down loads all attachments that begin with Mini Report and ends in xlsx.
The SSIS package opens the Excel file with the macro but then returns the ActiveX error. Again, if Outlook is closed, the SSIS package opens Excel, runs the macro (downloading the files) and saves them in our shared drive directory.
What have I coded that would require Outlook to be closed?
VBA code as follows:
Sub GetAttachments()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim FileName As String
Const num As Integer = 6
Const path As String = "Y:\Wireline Forecast\MiniReport - Production\Mini Report Region Automation\Load Files\"
Const strFileType As String = "xlsx"
Set olapp = CreateObject("outlook.application")
Set olmapi = getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)
If olmail.Items.restrict("[UNREAD]=True").Count = 0 Then
MsgBox ("No Unread mails")
Else
For Each olitem In olmail.Items.restrict("[UNREAD]=True")
If olitem.attachments.Count <> 0 Then
For Each olattach In olitem.attachments
If Left(olattach.FileName, 11) = "Mini Report" And Right(olattach.FileName, 4) = "xlsx" Then
FileName = "Y:\Wireline Forecast\MiniReport - Production\Mini Report Region Automation\Load Files\" & olattach.FileName
olattach.SaveAsFile FileName
End If
Next olattach
End If
Next olitem
End If
End Sub
This can happen if Outlook and Excel are running in different security contexts. Make sure that either both or neither apps are running with elevated privileges (Run As Administrator).
Actually found out that Outlook was "locked" when it was open so that explained the ActiveX error so I built a work around....I just added a script task that closes Outlook so the next Script Task can get the attachments then another Script Task that reopens Outlook. Not the prettiest or cleanest but it works for now.
I want to use Excel to store "tag names" in column A and their associated "replacement text" in Column B. When the code runs, it needs to collect each tag, one at a time (row by row), search an entire Word document for those words, and replace them with their corresponding replacements.
I noticed the special tags in the headers and footers weren't being replaced. I turned to this article (http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm) and found that working with a range of ranges (or cycling through all available Story Ranges in the document) I was able to do this.
I improved my code, as recommended in the link above and it worked, so long as my code was embedded in my "Normal" Word file, thereby using my VBA code from Word to operate on another Word document. However, the goal is to use VBA Excel to operate the replacements while reading an Excel file.
When I moved the code to Excel, I'm getting hung up on an Automation error which reads,
"Run-time error '-2147319779 (8002801d)': Automation error Library not registered.".
I've looked for answers from reviewing the Registry to using "Word.Application.12" in place of "Word.Application".
I have a Windows 7, 64-Bit machine, with Microsoft Office 2007. I have the following libraries selected:
Excel:
Visual Basic For Applications
Microsoft Excel 12.0 Object Library
OLE Automation
Microsoft Access 12.0 Object Library
Microsoft Outlook 12.0 Object Library
Microsoft Word 12.0 Object Library
Microsoft Forms 2.0 Object Library
Microsoft Office 14.0 Object Library
Word:
Visual Basic For Applications
Microsoft Word 12.0 Object Library
OLE Automation
Microsoft Office 12.0 Object Library
I have no issues with operating inside of Excel with regard to VBA. Normally, I will be passing a set of strings to this function, but for now, I have embedded the strings inside of the function, as if I am only planning on swapping one string (for any number of instances), with another predetermined string.
Function Story_Test()
Dim File As String
Dim Tag As String
Dim ReplacementString As String
Dim a As Integer
Dim WordObj As Object
Dim WordDoc As Object
Dim StoryRange As Word.Range
Dim Junk As Long
Dim BaseFile As String
'Normally, these lines would be strings which get passed in
File = "Z:\File.docx"
Tag = "{{Prepared_By}}"
ReplacementString = "Joe Somebody"
'Review currently open documents, and Set WordDoc to the correct one
'Don't worry, I already have error handling in place for the more complex code
Set WordObj = GetObject(, "Word.Application")
BaseFile = Basename(File)
For a = 1 To WordObj.Documents.Count
If WordObj.Documents(a).Name = BaseFile Then
Set WordDoc = WordObj.Documents(a)
Exit For
End If
Next a
'This is a fix provided to fix the skipped blank Header/Footer problem
Junk = WordDoc.Sections(1).Headers(1).Range.StoryType
'Okay, this is the line where we can see the error.
'When this code is run from Excel VBA, problem. From Word VBA, no problem.
'Anyone known why this is???
'***********************************************************************
For Each StoryRange In WordObj.Documents(a).StoryRanges
'***********************************************************************
Do
'All you need to know about the following function call is
' that I have a function that works to replace strings.
'It works fine provided it has valid strings and a valid StoryRange.
Call SearchAndReplaceInStory_ForVariants(StoryRange, Tag, _
ReplacementString, PreAdditive, FinalAdditive)
Set StoryRange = StoryRange.NextStoryRange
Loop Until StoryRange Is Nothing
Next StoryRange
Set WordObj = Nothing
Set WordDoc = Nothing
End Function
For Each StoryRange In WordObj.Documents(a).StoryRanges
should probably be
For Each StoryRange In WordDoc.StoryRanges
since you just assigned that in the loop above.
For now, I will have to conclude, as I don't have the possibility of testing the contrary, that there is a difference between using Microsoft Office 12 Object Library in one VBA environment, and Microsoft Office 14 Object Library in another. I don't have the means/authorizations to change either, so I must conclude, for now that is, that the difference between the two is the culprit. So, if I was to go forward and expect different results, I would assume Microsoft Office 12 Object Library to be the correct library, where 14 has a few differences that I am not aware of.
Thank you to all who provided input. If you have any other suggestions, we can discuss and forward. Thanks!
This is to update a bunch of links spread over body & Headers footers.
I didn't write this only from memory made a bunch of fixes, inclusions and tweaks.
It shows you how to cover all the different sections and can easily be modified to work within your parameters.
Please post your final code once done.
Public Sub UpdateAllFields()
Dim doc As Document
Dim wnd As Window
Dim lngMain As Long
Dim lngSplit As Long
Dim lngActPane As Long
Dim rngStory As Range
Dim TOC As TableOfContents
Dim TOA As TableOfAuthorities
Dim TOF As TableOfFigures
Dim shp As Shape
Dim sctn As Section
Dim Hdr As HeaderFooter
Dim Ftr As HeaderFooter
' Set Objects
Set doc = ActiveDocument
Set wnd = ActiveDocument.ActiveWindow
' get Active Pane Number
lngActPane = wnd.ActivePane.Index
' Hold View Type of Main pane
lngMain = wnd.Panes(1).View.Type
' Hold SplitSpecial
lngSplit = wnd.View.SplitSpecial
' Get Rid of any split
wnd.View.SplitSpecial = wdPaneNone
' Set View to Normal
wnd.View.Type = wdNormalView
' Loop through each story in doc to update
For Each rngStory In doc.StoryRanges
If rngStory.StoryType = wdCommentsStory Then
Application.DisplayAlerts = wdAlertsNone
' Update fields
rngStory.Fields.Update
Application.DisplayAlerts = wdAlertsAll
Else
' Update fields
rngStory.Fields.Update
End If
Next
'Loop through text boxes and update
For Each shp In doc.Shapes
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
Next
' Loop through TOC and update
For Each TOC In doc.TablesOfContents
TOC.Update
Next
' Loop through TOA and update
For Each TOA In doc.TablesOfAuthorities
TOA.Update
Next
' Loop through TOF and update
For Each TOF In doc.TablesOfFigures
TOF.Update
Next
For Each sctn In doc.Sections
For Each Hdr In sctn.Headers
Hdr.Range.Fields.Update
For Each shp In Hdr.Shapes
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
Next shp
Next Hdr
For Each Ftr In sctn.Footers
Ftr.Range.Fields.Update
For Each shp In Ftr.Shapes
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
Next shp
Next Ftr
Next sctn
' Return Split to original state
wnd.View.SplitSpecial = lngSplit
' Return main pane to original state
wnd.Panes(1).View.Type = lngMain
' Active proper pane
wnd.Panes(lngActPane).Activate
' Close and release all pointers
Set wnd = Nothing
Set doc = Nothing
End Sub
Before I begin, here is some history:
Created VBA in Excel to open and read three (3) Excel files (includes itself) and input data into charts/tables/graphs into a PowerPoint presentation. This version runs beautifully. VBA kicked off by a User Form
Modified code to fit a requirement passed down to me. This one causes the error of VBA Method 'Activate' of object 'ChartData' when loading a graph in one particular slide. This data is transferred from the sheet that kicks off the VBA.
I was unable to recreate this error steadily until I started saving the Excel file that kicks off the script when it asked. Now I can.
NO VBA resides in the powerpoint presentation.
Users testing this experience the error first time around. I do not. However, I do in the further iterations I do after saving the Excel book after either a successful or unsuccessful run.
Screen behaviors I've noticed when error occurs:
Only happens after I save the Excel that kicked off the procedure and I test the procedure again when trying to re-create error.
PowerPoint presentation becomes the 'activated' application while VBA runs in background
Happens on the same slide and chart (yes, using object labels in PowerPoint).
When error occurs and I break code, I can NOT close PowerPoint or Excel using the File menu. I HAVE to use the 'Red X' in the upper right hand corner to close. The ribbons and tabs are also unusable (do not react to a clicking event). Microsoft does ask the Save option.
What I've tried:
Walking through code and explicitly closing objects after they've been opened and are not required.
Varying the placement of the ScreenUpdating, etc. Application processes
Here is the function where it trips. It trips up at trpChartData.Activate for a particular graph (which is shapeName):
Function insGraphInfo(ByVal numOfSlide As Integer, ByVal shapeName As String, ByVal cellToMod As String, ByVal valToIns As Variant) As Variant
'Inserts data into a CHART TYPE graph
On Error GoTo ERR_INS_GRAPH
Dim trpChart As PowerPoint.Chart
Dim trpChartData As ChartData
Dim trpWkBk As Excel.Workbook
Dim trpChartSheet As Excel.Worksheet
Dim errString As String
Set oPPTSlide = oPPTFile.Slides(numOfSlide)
With oPPTSlide
.Select
End With
Set oPPTShape = oPPTFile.Slides(numOfSlide).Shapes(shapeName)
Set trpChart = oPPTShape.Chart
Set trpChartData = trpChart.ChartData
Debug.Print "Activating: " & shapeName & " in slide number: " & numOfSlide
errString = "Activating: " & shapeName & " in slide number: " & numOfSlide
trpChartData.Activate
Debug.Print shapeName & " activated."
errString = shapeName & " activated."
errString = "Setting Workbook and Worksheet Objects"
Set trpWkBk = trpChartData.Workbook
Set trpChartSheet = trpWkBk.Worksheets(1)
errString = "Inserting Value into appropriate cell)"
With trpChartSheet
.Range(cellToMod).Value = valToIns
End With
insGraphInfo = valToIns
errString = "Refreshing Chart."
With oPPTShape 'Refreshes
.Chart.ChartData.Activate
.Chart.ChartData.Workbook.Close
.Chart.Refresh
End With
Set trpWkBk = Nothing
Set oPPTSlide = Nothing
Set oPPTShape = Nothing
Exit Function
ERR_INS_GRAPH:
MsgBox "An error occurred while: " & errString
Resume Next
End Function
Excel and PowerPoint are created by two different teams of developers.
PowerPoint.Chart is not the same as Excel.Chart
Yes, they look the same and you would think that you have the same level of access to their properties, but that is where you would be wrong. The PowerPoint version is very limited.
Anyway, as far I can tell, you went wrong when you declared
Dim trpChartData As ChartData
Instead of
Dim trpChartData As PowerPoint.ChartData
As Rachel pointed out,
trpChartData is declared without a library qualifier and thus defaults to Excel.ChartData
In addition to that you never cleared trpChartData with
Set trpChartData = Nothing
I also don't see where you .Quit the Excel application for the Chart.Workbook that must have been created. This could explain why there were versions of Excel open in the Task Manager afterwards. Try adding this...
Dim xlApp as Excel.Application
'
'
Set xlApp = .Chart.ChartData.Workbook.Application
'
'
xlApp.Quit
Set xlApp = Nothing