I'm trying to make a simple square in AutoCAD using VBA but when I try to run my code I get an "Out of Range" Error? Any help would be great!
Sub box()
'Link the Exel File to the open CAD File'
'If no CAD file open it does create one'
'----------------------------------------------------------------'
Dim ACAD As AcadApplication 'Create ACAD variable of type AcadApplication
On Error Resume Next 'This tells VBA to ignore errors
Set ACAD = GetObject(, "AutoCAD.Application") 'Get a running instance of the class AutoCAD.Application
On Error GoTo 0 'This tells VBA to go back to NOT ignoring errors
If ACAD Is Nothing Then 'Check to see if the above worked
Set ACAD = New AcadApplication 'Set the ACAD variable to equal a new instance of AutoCAD
ACAD.Visible = True 'Once loaded, set AutoCAD® to be visible
End If
ACAD.ActiveDocument.Utility.Prompt "Hello from Excel!" 'Print a message to the AutoCAD® command line
Dim squareObj As Acad3DSolid
Dim center(0 To 2) As Double
center(0) = 10
center(1) = 10
center(2) = 0
Set squareObj = ACAD.ActiveDocument.ModelSpace.AddBox(center, 2, 2, 0)
End Sub
From Autodesk
https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2016/ENU/AutoCAD-ActiveX/files/GUID-DE469E81-8531-415C-9D22-7041A42838DD-htm.html
RetVal = object.AddBox(Origin, Length, Width, Height)
The height of the box. Must be a positive number since it seems like autocad won't create a 3d solid with zero height.
Related
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.
I have two macros, one in Excel, and one in Word. The Excel Macro calls the Word macro. My code is as follows:
Excel:
Public wb1 As Workbook
Public dt1 As Document
Sub openword()
Dim wpath, epath As String 'where the word document will be opened and where the excel sheet will be saved
Dim wordapp As Object 'preparing to open word
Set wb1 = ThisWorkbook
While wb1.Sheets.Count <> 1
wb1.Sheets(2).Delete
Wend
wpath = "C:\users\GPerry\Desktop\Projects and Work\document.docm"
Set wordapp = CreateObject("Word.Application")
'Set wordapp = CreateObject(Shell("C:\Program Files (x86)\Microsoft Office\Office14\WINWORD", vbNormalFocus)) this is one I tried to make work because while word.application seems to work, I don't *understand* it, so if anyone can help, that'd be awesome
wordapp.Visible = True
Set dt1 = wordapp.Documents.Open(wpath)
wordapp.Run "divider", wb1, dt1
dt1.Close
wordapp.Quit
End Sub
And word:
Sub divider(wb1, dt1)
Set dt1 = ThisDocument
If dt1.Paragraphs.Count > 65000 Then
Set cutrange = dt1.Range(dt1.Paragraphs(1).Range.Start, dt1.Paragraphs(65000).Range.End)
If wb1.Sheets(Sheets.Count).Cells(1, 1) <> "" Then
wb1.Sheets.Add After:=Sheets.Count
End If
Else
Set cutrange = dt1.Content
If wb1.Sheets(Sheets.Count).Cells(1, 1) <> "" Then
wb1.Sheets.Add After:=Sheets.Count
End If
End If
cutrange.Cut Destination:=wb1.Sheets(wb1.Sheets(Sheets.Count)).Cells(1, 1)
wb1.Sheets(Sheets.Count).Cells(1, 1).TextToColumns Destination:=wb1.Sheets(1).Cells(1, 1)
End Sub
My problem is that the variable wb1 isn't getting passed between them. Even though I put wb1 in the list of variables to send to the macro, when it arrives at the document, wb1 has no value inside of it. I would re-initialize it, but I don't know how to refer to an already existing document - only how to set it equal to one as you open it.
So either how do I pass the value through into the Word macro, or how do I re-initialize this variable? Preferably without having to set something equal to the excel application, because every time I try that it sets it equal to Excel 2003, not 2010 (though any solutions to that are also, of course, welcome).
Thanks!
You can't use the Excel global objects from inside of Word without explicitly qualifying them (they simply don't exist there). In particular, that means you can't use Sheets. You should also explicitly declare the variable types of your parameters - otherwise they'll be treated as Variant. This is important with reference types because in that it helps prevent run-time errors because the compiler knows that the Set keyword is required.
Sub divider(wb1 As Object, dt1 As Document)
Set dt1 = ThisDocument
If dt1.Paragraphs.Count > 65000 Then
Set cutrange = dt1.Range(dt1.Paragraphs(1).Range.Start, dt1.Paragraphs(65000).Range.End)
If wb1.Sheets(wb1.Sheets.Count).Cells(1, 1) <> "" Then
wb1.Sheets.Add After:=wb1.Sheets.Count
End If
Else
Set cutrange = dt1.Content
If wb1.Sheets(wb1.Sheets.Count).Cells(1, 1) <> "" Then
wb1.Sheets.Add After:=wb1.Sheets.Count
End If
End If
cutrange.Cut Destination:=wb1.Sheets(wb1.Sheets(wb1.Sheets.Count)).Cells(1, 1)
wb1.Sheets(wb1.Sheets.Count).Cells(1, 1).TextToColumns Destination:=wb1.Sheets(1).Cells(1, 1)
End Sub
Note - you also don't need to pass dt1 at all. You never use the value in the parameter and actually set it to something else. This could be a source of errors if you're using internal calls, because dt1 is implicitly passed ByRef (it gets boxed when you call it through Application.Run). That means whenever you call divider, whatever you pass to dt1 in the calling code will change to ThisDocument. You should either remove the parameter or specify that it is ByVal.
Borrowed from another SO link.
Sub Sample()
Dim wdApp As Object, newDoc As Object
Dim strFile As String
strFile = "C:\Some\Folder\MyWordDoc.dotm"
'~~> Establish an Word application object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
wdApp.Visible = True
Set newDoc = wdApp.Documents.Add(strFile)
Call wdApp.Run("YHelloThar", "Hello")
'
'~~> Rest of the code
'
End Sub
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
I want to write a single VBA code module that works on the three main Office Apps (Excel, PowerPoint, Word).
Because the object models are different in each app, if I write code that's specific for PowerPoint while in the Excel VBE, the project won't compile. The way to go first appears to be to use conditional compiler constants. But this still causes the VBE to spit out errors depending on which MSO app the VBE is currently being hosted in.
In the simplified example below, I want to add a picture to a sheet, slide or document, depending on which app the VBA code is being run from. If I try to compile it in Excel, the PowerPoint code doesn't compile (even though it's within a conditional compiler If...Then statement!) and vice-versa. How does one get round this without adding references to the other MSO apps (as this causes compatibility issues when distributing to different MSO versions)?
The way the compiler continues to look at code that should be effectively "commented out" by the conditional compiler constants is very odd/annoying behaviour!
' Set the compiler constant depending on which MSO app is hosting the VBE
' before saving as the respective .ppam/.xlam/.dotm add-in
#Const APP = "EXL"
Option Explicit
Dim curSlide As Integer
Dim curSheet As Integer
Public Sub InsertPicture()
Dim oShp as Shape
#If APP = "PPT" Then
' Do PowerPoint stuff
' The next 2 lines will throw "Invalid qualifier" and
' "Variable not defined" errors respectively when compiling in Excel.
curSlide = ActiveWindow.View.Slide.SlideIndex
Set oShp = ActivePresentation.Slides(curSlide).Shapes.AddPicture & _
(filename, msoFalse, msoTrue, 0, 0)
#ElseIf APP = "EXL" Then
' Do Excel stuff
curSheet = ActiveWindow.ActiveSheet
Set oShp = ActiveSheet.AddPicture(filename, msoFalse, msoTrue, 0, 0)
#ElseIf APP = "WRD" Then
' Do Word stuff
#End If
End Sub
Since I'm unable to answer my own question:
Expanding on your idea KazJaw, I think something like this may work, replacing the CreateObject function with GetObject (because the instance will already exist since the procedure is being called from within an add-in):
' CONDITIONAL COMPILER CONSTANTS
' Set this value before saving to .ppam, .xlam or .dotm
#Const APP = "EXL" ' Allowed Values : PPT, EXL or WRD
Sub One_Sub_For_Word_Excel_PP(filename As String, Optional SlideIndex as Integer)
#If APP = "PPT" Then
Dim appPPP As Object
Set appPPT = GetObject(, "PowerPoint.Application")
appPPT.ActivePresentation.Slides(SlideIndex).Shapes.AddPicture & _
(filename,msoFalse,msoTrue,0,0)
#ElseIf APP = "EXL" Then
Dim appEXL As Object
Set appEXL = GetObject(, "Excel.Application")
appEXL.ActiveSheet.AddPicture(filename, msoFalse, msoTrue, 0, 0)
#ElseIf APP = "WRD" Then
Dim appWRD As Object
Set appWRD = GetObject(, "Word.Application")
appWRD.ActiveDocument.AddPicture(filename, msoFalse, msoTrue, 0, 0)
#End If
End Sub
You could try:
Public AppName as String
Public App as Object
Sub One_Sub_For_Word_Excel_PP(filename As String, Optional SlideIndex as Integer)
AppName = Application.Name
Set App = Application
Select Case AppName
Case "Microsoft PowerPoint"
App.ActivePresentation.Slides(SlideIndex).Shapes.AddPicture & _
(filename,msoFalse,msoTrue,0,0)
Case "Microsoft Excel"
App.ActiveSheet.AddPicture(filename, msoFalse, msoTrue, 0, 0)
Case "Microsoft Word"
App.ActiveDocument.AddPicture(filename, msoFalse, msoTrue, 0, 0)
End Select
End Sub
Alternatively, write a COM Add-in.
As I stated in my comment- I can't imagine the situation I would like to use the solution you are trying to prepare. However, there is one solution even you set lot's of limitations (including not setting references to other application libraries). Please keep in mind that such attempt will be not efficient and I would never recommend anything like this.
The following test subroutine works for all three applications: MS Word, MS PowerPoint, MS Excel. Additional information in comments inside the code.
Sub One_Sub_For_Word_Excel_PP()
Dim XLS As Object
Dim PP As Object
Dim WRD As Object
'this will open instances of all application- to avoid any errors
Set XLS = CreateObject("Excel.Application")
Set PP = CreateObject("PowerPoint.Application")
Set WRD = CreateObject("Word.Application")
'your code here
'remember- do not use vba constants like msoFalse but use _
their numeric values instead
'simple test
If Application.Name = "Microsoft Excel" Then
'do things only for excel
Debug.Print XLS.Name
ElseIf Application.Name = "Microsoft PowerPoint" Then
'do things only for PP
Debug.Print PP.Name
Else
'do things only for Word
Debug.Print WRD.Name
End If
Set XLS = Nothing
Set PP = Nothing
Set WRD = Nothing
End Sub
Isn't it
#Const APP = "EXL"
#If APP = "PPT" Then
etc.?
I'm assuming that you want the same code to be able to run from within any VBA-enabled app (but not necessarily to invoke other apps). So ...
Sub One_Sub_To_Rule_Them_All()
' Modified version of KazJaw's previous post
Dim oApp As Object
Set oApp = Application
Select Case oApp.Name
Case Is = "Microsoft Excel"
'do things only for excel
Case Is = "Microsoft PowerPoint"
'do things only for PP, eg
MsgBox oApp.ActivePresentation.Fullname
Case Is = "Microsoft Word"
' do wordthings
Case Is = "Visio or CorelDraw or Whatever"
' do whatever things
Case Else
MsgBox "Jumping up and down and waving hands and running around like headless chicken"
End Select
Set oApp = Nothing
End Sub
All the same, I wouldn't do it this way. Apart from the other objections, you need to treat the apps as objects in order for the code to compile, and when you do that, you toss out intellisense. Not a trivial loss. Sure, you can get around that by developing the Word part in Word, the PPT part in PPT ... but in that case, why not just make separate code modules?
I have a VBA module in MS-Access that is supposed to load data from a database into Form Fields in a MS-Word document. I thought it was working fine, but it appears to be inconsistent. Sometimes it works and sometimes it doesn't. I can't figure out what keeps it from working. When I step through the debugger it doesn't throw any errors, but sometimes it doesn't open MS-Word.
Here is the relevant code:
Dim appWord As Word.Application
Dim doc As Word.Document
'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
Set appWord = New Word.Application
End If
Set doc = appWord.Documents.Open("\\srifs01\hresourc\EHS Department\EHS Database\IpadUpload\Lab Inspection Deficiency Resolution Report.docx", , True)
'Sometimes word doesn't open and I think the issue is around here.
With doc
.FormFields("frmID").Result = Me!id
.FormFields("frmSupervisor").Result = Me!LabPOC
.FormFields("frmInspector").Result = Me!InspectorName
.FormFields("frmBuilding").Result = Me!BuildingName
.FormFields("frmRoom").Result = Me!Rooms
.FormFields("frmComments").Result = Me!Comments
.Visible = True
.Activate
.SaveAs "'" & Me!id & "'"
.Close
End With
Set doc = Nothing
Set appWord = Nothing
Any help is appreciated. Thanks in advance.
"When I step through the debugger it doesn't throw any errors, but sometimes it doesn't open MS-Word."
That's because you have On Error Resume Next. That instructs VBA to ignore errors.
Assume you've made this change in your code ...
Dim strDocPath As String
strDocPath = "\\srifs01\hresourc\EHS Department\EHS Database" & _
"\IpadUpload\Lab Inspection Deficiency Resolution Report.docx"
Then, when you attempt to open strDocPath, VBA would throw an error if appWord isn't a reference to a Word application instance ... AND you haven't used On Error Resume Next:
Set doc = appWord.Documents.Open(strDocPath, , True)
You can get rid of On Error Resume Next if you change your assignment for appWord to this:
Set appWord = GiveMeAnApp("Word.Application")
If Word was already running, GiveMeAnApp() would latch onto that application instance. And if Word was not running, GiveMeAnApp() would return a new instance.
Either way, GiveMeAnApp() doesn't require you to use On Error Resume Next in your procedure which calls it. Include a proper error handler there instead. And you can reuse the function for other types of applications: GiveMeAnApp("Excel.Application")
Public Function GiveMeAnApp(ByVal pApp As String) As Object
Dim objApp As Object
Dim strMsg As String
On Error GoTo ErrorHandler
Set objApp = GetObject(, pApp)
ExitHere:
On Error GoTo 0
Set GiveMeAnApp = objApp
Exit Function
ErrorHandler:
Select Case Err.Number
Case 429 ' ActiveX component can't create object
Set objApp = CreateObject(pApp)
Resume Next
Case Else
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure GiveMeAnApp"
MsgBox strMsg
GoTo ExitHere
End Select
End Function
You could also include a check to make sure appWord references an application before you attempt to use it. Although I don't see why such a check should be necessary in your case, you can try something like this ...
If TypeName(appWord) <> "Application" Then
' notify user here, and bail out '
Else
' appWord.Visible = True '
' do stuff with Word '
End If
I don't use the New keyword when opening or finding an application.
This is the code I use for excel:
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number = 429 Then 'Excel not running
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
(note also the On Error GoTo 0 - I don't want the resume next to be active all through the code)
The GiveMeAnApp function worked great for me with a similar problem I was experiencing. Except, to avoid Error 462 (cannot connect to server etc) if I closed the Word document after the data merge and attempted another merge of data to Word. (which caused error 462) I did this: Once I call GiveMeAnApp I then called for a New Word document before calling the Word template I wished to transfer data to Word into.
By always having the New Word document present this avoided error 462 in my circumstances. It means I am left with an empty Word doc but this is ok for me and preferable to the only other solution I could come up with which was to quit the db and re open and run the merge to Word aga.
I am grateful for the help set out in this thread. Thanks all.