Assign a Word variable through Outlook - vba

I have a database management tool that runs on multiple Office apps.
I use Outlook to receive variables from a userform which is then sent to a Word template file, creating a new Word document.
When Outlook calls Word and creates a document, I need to assign a value to a Boolean variable stored in a Word module. Either true or false, depending on the user input.
The Boolean is used to decide which lines of code run on a Word userform the user can later open, but not in the document itself (i.e. inserted into one of the fields in the document).

So, if I correctly understood your question, your Word application has a variable "stored in a Word module". Let us say that this variable will be:
Public boolTest As Boolean
If you will have a Sub in that specific module (in 'Normal.dotm' or in a docm document), let us say:
Sub testBooleanChange(boolT As Boolean)
boolTest = boolT
MsgBox boolTest
End Sub
If Outlook will call the above Sub as:
objWord.Run "testBooleanChange", True
Then your boolTest variable will take the sent Boolean Value
In fact, a real code dealing with the above suggestion will look like that:
Sub testCallWordProc()
Dim W As Word.Application
On Error Resume Next
Set W = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Set W = CreateObject("Word.Application")
End If
W.Visible = True
'If the Sub in discussion exists in a document, un-comment the next line and use your real document full name:
'W.Documents.Open ("Your doc keeping the sub.docm")
'If the Sub is inside the 'Normal' you can simply use:
W.RUN "testBooleanChange", True
End Sub

Related

Selection.Goto from Excel to Word

I am using a spreadsheet to capture test cases, and in the process of automating the generation of a Word document for presentation to the business. I can't get the GoTo function to work across the files, however.
All of the subs are written in the Excel VBA instance.
Here are the two pertinent subs:
Sub 1
Sub CreateTestDocument()
Set wordapp = CreateObject("word.Application")
Set Wordfile = wordapp.Documents.Open("S:\myPath\myFilename.dotm")
wordapp.Visible = True
AddNextCase ("FeatureCases")
End Sub
'Sub 2 (called from Sub 1)
Sub AddNextCase(Bmark As String)
Wordfile.Activate
Wordfile.SelectAllEditableRanges
ActiveWindow.Selection.Goto What:=wdGoToBookmark, Name:=Bmark 'ERROR HERE
Selection.TypeText "TEST1"
End Sub
on the Selection.Goto line, I get the error below:
Run-time error 438:
Object doesn't support this property or method
I've tried various different approaches to this, but i always hit a blocker on setting my entry point to start putting this text block in, what's the obvious issue i'm missing?
You need to make sure that a couple things are addressed:
Make sure that the wordapp and wordfile objects are defined at the module level. I have shown this below using object type references from the Microsoft Word XX.X Object Library. This will also make sure that any word constants you use are defined.
Then you need to use the wordapp context for the activewindow call. This is done with wordapp.activewindow
Private wordapp As Word.Application, _
wordfile As Word.Document
Sub CreateTestDocument()
Set wordapp = CreateObject("word.Application")
Set wordfile = wordapp.Documents.Open("FILE NAME")
wordapp.Visible = True
AddNextCase ("FeatureCases")
End Sub
Sub AddNextCase(Bmark As String)
wordfile.Activate
wordfile.SelectAllEditableRanges
wordapp.ActiveWindow.Selection.Goto What:=wdGoToBookmark, Name:=Bmark
wordapp.Selection.TypeText "TEST1"
End Sub
As per MDN (paraphrased):
.ActiveWindow is an Application property that returns the
active window (Window Object).
You can't however apply a method to a property, you need to apply it to a Window Object instead. Easiest way of achieving this is to store the window object into a variable.
Additionally, your variables such as wordapp or Wordfile are presumably objects, since you have Set them, but there are nowhere declared in your code.
So your code should look something like this:
Private Wordfile as Word.Document
Set Wordfile = CreateObject("word.Application")
Private word as Word.Application
Set word = wordapp.Documents.Open("S:\myPath\myFilename.dotm")
' ... rest of the code
wordapp.ActiveWindow.Selection.GoTo '... etc
In general I would recommend doing a bit of studying into objects, because it looks like you have some learning gaps (with all due to respect)

Detect if an object has been disconnected from its clients

I am having an issue with automating an Excel file. The VBA script within Excel first opens a Word application and Word document:
Dim wordApp As Object
Set wordApp = CreateObject("Word.Application")
vPath = Application.ActiveWorkbook.Path
Set wordDoc = wordApp.Documents.Open(vPath & "\test.doc")
And then I call a subroutine within the Word document passing some data from the Excel file:
Call wordApp.Run("StartWithData", variable1, variable2)
If Excel detects that an error occurs in that subroutine, I close the Word document and Word application from Excel in a label I call Err1:
On Error Goto Err1
'all the code from above
Exit Sub
Err1:
wordDoc.Close wdCloseWithoutSaving
wordApp.Quit SaveChanges:=wdDoNotSaveChanges
Set wordDoc = Nothing
Set wordApp = Nothing
This works perfectly fine under normal circumstances; however, if the Word document or application are closed before the Err1 label executes (such as the user manually closing the document), I get the following error:
Run-time error '-2147417848 (80010108)':
Automation error The object invoked has disconnected from its clients.
which makes perfect sense because the wordApp and/or wordDoc variables still reference the Application and Document objects and those objects do not exist anymore (yet are also not considered to be Nothing).
So here is my inquiry: Is there a way to check if an object has been disconnected from its client before the run-time error occurs so as to avoid having to rely on on error resume next?
Such as:
If Not isDisconnected(wordDoc) Then
wordDoc.Close wdCloseWithoutSaving
End If
If Not isDisconnected(wordApp) Then
wordApp.Quit SaveChanges:=wdDoNotSaveChanges
End If
Update 1:
After looking at omegastripes' answer, I realized that the error given above only occurs when the document (wordDoc) was the object that got disconnected. If the Word application (wordApp) is what got disconnected, I get the following error:
Run-time error '462':
The remote server machine does not exist or is unavailable
Consider the below example:
Sub Test()
Dim wordApp As Object
Dim wordWnd As Object
Dim wordDoc As Object
Set wordApp = CreateObject("Word.Application")
Set wordWnd = wordApp.Windows ' choose any object property as indicator
wordApp.Visible = True ' debug
Set wordDoc = wordApp.Documents.Open(Application.ActiveWorkbook.Path & "\test.doc")
MsgBox IsObjectDisconnected(wordWnd) ' False with opened document
wordDoc.Close
MsgBox IsObjectDisconnected(wordWnd) ' False with closed document
wordApp.Quit ' disconnection
MsgBox IsObjectDisconnected(wordWnd) ' True with quited application
End Sub
Function IsObjectDisconnected(objSample As Object) As Boolean
On Error Resume Next
Do
IsObjectDisconnected = TypeName(objSample) = "Object"
If Err = 0 Then Exit Function
DoEvents
Err.Clear
Loop
End Function
Seems any type detection of the variable, which references to the intrinsic Word objects, like .Documents, .Windows, .RecentFiles, etc., made immediately after document close or application quit commands have been invoked, may throw the error 14: Out of string space, while Word application processing the command. The same detection on the Applicationobject , may also hang Excel application.
In the example TypeName() call is wrapped into OERN loop, that should skip irrelevant results to get explicit disconnection feedback, relying on the type name, but not on the error number. To avoid hanging, .Windows property is being checked instead of Application.

MS Word's grammar checker launches with VBA delete all line breaks in MS Access form

I have this code in VBA which launches MS Word spelling and grammar checker after I exit text box of a ms Access form.
After the check is run, and the text sent back to the form, all the line breaks of my text are gone. My data look like a single paragraph instead of having nice formatting.
This happen on the Access side as the .doc that I see just at the end of the spelling check still has the line breaks.
Thanks a lot for your help!
Option Compare Database
Private Sub Description_Exit(Cancel As Integer)
Call SpellIt(Description)
End Sub
Public Function SpellIt(ctrl As Control)
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
On Error GoTo SpellIt_Err
Set wdApp = New Word.Application
wdApp.Visible = True
wdApp.Activate
If Not IsNull(ctrl) Then
Set wdDoc = wdApp.Documents.Add
wdApp.Selection.Text = ctrl
wdApp.Dialogs(wdDialogToolsSpellingAndGrammar).Show
If Len(wdApp.Selection.Text) <> 1 Then
ctrl = wdApp.Selection.Text
Else
wdDoc.Close wdDoNotSaveChanges
wdApp.Quit
Set wdApp = Nothing
Exit Function
End If
wdDoc.Close wdDoNotSaveChanges
End If
wdApp.Quit
Set wdApp = Nothing
MsgBox "Spelling and Grammar Check Complete.", vbInformation, "Microsoft Word Spelling And Grammar:"
Exit Function
SpellIt_Err:
Err.Clear
ctrl.Undo
MsgBox "We encountered an error in it's conversation with Microsoft Word regarding your comment." & vbCrLf & _
"As a precaution, any changes made within the grammar and spelling dialog box have not been retained.", _
vbCritical, "Spelling and Grammar Check NOT Complete:"
End Function
Looks like MS Word is using different linebreak characters than Access textbox controls. You can revert the characters back to their original used in Access after spellcheck by replacing this line:
ctrl = wdApp.Selection.Text
with:
ctrl = Replace(wdApp.Selection.Text, vbCr, vbCrLf)

Excel VBA: How to implement timer to check for code timeout

I have some code that runs on workbook open that uses a form to request that the user select the drive to which a shared directory is mapped.
This is because the workbook uses VBA code to retrieve and save data to a shared workbook located in this shared directory, but the local drive changes by user, so they need to select it.
The problem I've run into occurs when the user has mapped multiple shared directories to their computer and thus have multiple drives... ex: 1 directory is on drive G: and the other is on X:.
If they select the drive for the shared directory in which the workbook resides, there is no problem. However, if they accidentally choose the drive for the other shared directory, the code hangs.
I have a loop setup that checks to see they've chosen the correct drive... IE: If they chose A: (a non-existent drive in my example), then the code will note that they chose the incorrect drive and prompt them again.
However, instead of creating an error when another shared directory is chosen, the code just hangs.
In the below code, cell AD3 on sheet one contains true or false (gets set to false in the beginning of the sub). It gets set to true if they've chosen correct drive as Module6.PipelineRefresh will no longer cause an error (this sub attempts to open the workbook in the shared drive... and if the chosen drive is incorrect it obviously returns an error)
Codes is as below:
Do While Sheet1.Range("ad3") = False
On Error Resume Next
Call Module6.PipelineRefresh '~~ I'm guessing the code hangs here. Instead of returning an error immediately, as it would if they simply chose a non-existant drive, it appears to get stuck trying to open the workbook, even though it's not located in the shared directory they've selected.
If Err.Number = 0 Then
Sheet1.Range("ad3") = True
Err.Clear
Else
MsgBox "Invalid Network Drive."
DriverSelectForm.Show
Err.Clear
End If
Loop
If anyone knows how to implement a timer so I can shutdown the code after some amount of time, that'd be great.
Alternatively, if you know how to get around this error, that'd also be great!
EDIT as per comment:
This is the specific code in Module6.PipelineRefresh that hangs. The DriverSelectForm (shown above) amends the value in cell o1 to the chosen drive string (ie: X:)
Dim xlo As New Excel.Application
Dim xlw As New Excel.Workbook
Dim xlz As String
xlz = Sheet1.Range("o1").Value & "\Region Planning\Created Pipeline.xlsx"
Dim WS As Worksheet
Dim PT As PivotTable
Application.DisplayAlerts = False
Set xlw = xlo.Workbooks.Open(xlz)
Application.DisplayAlerts = True
Note: As stated above, if the user selects a non-existent directory, the above code returns an error immediately because it cannot open the file... if they have a shared directory mapped to the chosen drive (but it's the wrong directory), the code will hang and does not appear to return an error.
I've answered my own question by working around the problem. Instead of checking that the user has selected the correct drive letter, I am now using the CreatObject function to find the drive letter associated with the drive name (as drive name will not change).
Example code for this:
Dim objDrv As Object
Dim DriveLtr As String
For Each objDrv In CreateObject("Scripting.FileSystemObject").Drives
If objDrv.ShareName = "Shared Drive Name" Then
DriveLtr = objDrv.DriveLetter
End If
Next
If Not DriveLtr = "" Then
MsgBox DriveLtr & ":"
Else
MsgBox "Not Found"
End If
Set objDrv = Nothing
The solution to stop some code by timer. The code must be placed in a module.
Private m_stop As Boolean
Sub stop_timer(p_start_time As Variant)
Application.OnTime p_start_time, "stop_loop"
End Sub
Sub signal_timer(p_start_time As Variant)
Application.OnTime p_start_time, "signal_in_loop"
End Sub
Sub test_loop()
Dim v_cntr As Long
m_stop = False
v_cntr = 0
stop_timer Now + TimeValue("00:00:05")
signal_in_loop
While Not m_stop
v_cntr = v_cntr + 1
DoEvents
Wend
Debug.Print "Counter:", v_cntr
End Sub
Sub stop_loop()
m_stop = True
End Sub
Sub signal_in_loop()
Debug.Print "timer:", Timer
If Not m_stop Then
signal_timer Now + TimeValue("00:00:01")
End If
End Sub
Output:
timer: 50191.92
timer: 50192
timer: 50193
timer: 50194
timer: 50195
timer: 50196
Counter: 67062
timer: 50197.05
m_stop controls the loop. DoEvents calls event handlers such as stop_loop and signal_in_loop as defered procedures.

Word vba document.readonly status incorrectly returns false

I have an excel project that checks word documents for a changed modify date and, if changed, it opens that document and imports the text from the word form fields into excel.
The routine in excel that opens and imports the word documents is as follows:
Sub CopyFromWord(pFile as String,aFile as string)
Dim wdApp As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
Else 'word is already running
End If
On Error Goto 0
Set wdDoc = wdApp.Documents.Open(Filename:="" & pFile & "", ReadOnly:=True)
wdApp.Visible = False
For Each c In wdDoc.bookmarks
'removed code that copies values from word doc fields to excel sheet
Next c
wdApp.Activedocument.Close SaveChanges:=False
End Sub
The word documents all started out as copies of the same file. There are a few thousand copies of the file, but each located in their own folder with a unique name.
The user finds the folder they need and opens the word document within it. It bring up a userform and then populates formfields in the document with the input to the userform. A command button then saves and exits the form.
Because the welcome message/userform loads automatically upon the document opening, I added the following code into the open event for the document:
Sub Document_Open()
If ThisDocument.ReadOnly = True then Exit Sub
msgbox "Welcome " & Environ$("Username") & ". Click OK to begin."
Userform1.show
End sub
This ensures when the excel project loops through all the files, if it finds one has changed, it needs to open the file (read only) so it can import the data without being interrupted with a userform / welcome message, close it, and carry on searching looping all files checking for changed modify-dates.
It should run constantly, however, about 20% of the time, a document will be opened read only by the excel code, but the welcome messagebox in the word document will show, indicating thisdocument.readonly incorrectly returned false.
If I debug the word document in this scenario, and do
? thisdocument.readonly
I get a "false" result. However, even the title bar of the word document ends with " (Read-Only)" so it has clearly been opened read-only, thus readonly should return True.
It is not specific to any documents, if I try to repeat opening them it seems to work the next time round (in that it correctly registers a read-only and exits the sub before the messagebox code). I cant find any kind of pattern and can't find any info online, I've been searching this for weeks!
May not be considered the answer, but following Tim William's suggestion, I managed to put together this which completely solves my problem. I struggled at first because I was trying to set the property too early. Complete code is as follows:
Sub CopyFromWord(pFile as String)
Dim wdApp As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
Else 'word is already running
End If
On Error Goto 0
'save current setting
secAutomation = wrdApp.Application.AutomationSecurity
'set Word to disable macros when a document is opened via vb:
wrdApp.Application.AutomationSecurity = msoAutomationSecurityForceDisable
'(without using wrdApp prefix it would only apply to the code's App i.e. Excel)
Set wdDoc = wdApp.Documents.Open(Filename:="" & pFile & "", ReadOnly:=True)
wdApp.Visible = False
For Each c In wdDoc.bookmarks
'removed code that copies values from word doc fields to excel sheet
Next c
'restore original setting before closing
wrdApp.Application.AutomationSecurity = secAutomation
wdApp.Activedocument.Close SaveChanges:=False
End Sub
Many thanks to Tim Williams for the link, and the guy who provided the code within the content of that link. This was such a help and is most appreciated.