How to call Word macros from Excel - vba

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

Related

accessing word variable or content control from outlook vba

I'm trying to access from Outlook VBA, either a variable or content control ID that I've created in a word Macro.
Basically I am trying to get set a text field equal to a string variable and load this variable to a message box in outlook.
From outlook, I have the code that creates a word object, and opens the active document, but I'm confused as to accessing the variables. I've tried making the variable in word VBA a public variable with no luck.
Current code to access the variable from outlook:
Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open("C:\Owner\Desktop\Job.docx")
oWordApp.Visible = True
MsgBox(oWordApp.testtest)
Having a look at the ContentControl help file you can pull back the text from the content control using its Tag property.
Sub Test()
Dim oWordApp As Object
Dim oWordDoc As Object
Dim oContent As Variant
Dim oCC As Variant
Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open("S:\DB_Development_DBC\Test\MyNewDoc.docm")
oWordApp.Visible = True
Set oContent = oWordDoc.SelectContentControlsByTag("MyCalendarTag")
If oContent.Count <> 0 Then
For Each oCC In oContent
MsgBox oCC.PlaceholderText & vbCr & oCC.Range.Text
Next oCC
End If
End Sub
The code above displayed Click here to enter a date. as the PlaceHolderText value and 01/01/2007 as the Range.Text value. So no need to add separate functions; just reference the content control directly.
https://msdn.microsoft.com/en-us/library/office/gg605189(v=office.14).aspx
https://msdn.microsoft.com/en-us/vba/word-vba/articles/working-with-content-controls
Edit
As an example of returning value from multiple controls in one function:
Public Sub Example()
Dim MySevenTags As Variant
Dim x As Long
MySevenTags = Array("Tag1", "Tag2", "Tag3", "Tag4", "Tag5", "Tag6", "Tag7")
For x = LBound(MySevenTags) To UBound(MySevenTags)
MsgBox ReturnFromWordContent(CStr(MySevenTags(x))), vbOKOnly
Next x
End Sub
Public Function ReturnFromWordContent(TagID As String) As Variant
Dim oWordApp As Object
Dim oWordDoc As Object
Dim oContent As Variant
Dim oCC As Variant
Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open("S:\DB_Development_DBC\Test\MyNewDoc.docm")
oWordApp.Visible = True
Set oContent = oWordDoc.SelectContentControlsByTag(TagID)
'I've made this next bit up.
'No idea how to get the type of control, or how to return the values.
Select Case oContent.Type
Case "calendar"
ReturnFromWordContent = oContent.Range.Date
Case "textbox"
ReturnFromWordContent = oContent.Range.Text
Case Else
'Return some default value such as Null which
'won't work in this case as it's returning to a messagebox
'but you get the picture.
End Select
' If oContent.Count <> 0 Then
' For Each oCC In oContent
' MsgBox oCC.PlaceholderText & vbCr & oCC.Range.Text
' Next oCC
' End If
End Function
"I've tried making the variable in word VBA a public variable with no luck."
Declare your macro "testtest" as a function with the return value of your variable.
Public Function testtest() As String
dim myVariabel as String
myVariable = "test"
' return value
testtest = myVariable
End Function
Best regards

How to select all text and change spelling language?

I need to select the entire text in the email I'm typing, and change the spelling language.
The following works in Word but doesn't in Outlook 2013.
I added Microsoft Word 15 Object library, with tools -> references, from the VBA editor window.
Selection.WholeStory
Selection.LanguageID = wdEnglishUK
Selection.NoProofing = False
Application.CheckLanguage = False
Methods and properties specific to one application's VBA language can't be used in other applications like that.
There is a lot of information out there, try a search for "Outlook VBA Change Message Body Language" and variations of that.
Some resources to get you started:
Stack Overflow: Outlook VBA Set language of selection
MSDN: Working with Item Bodies with Outlook/VBA
MSDN: MailItem Object (Outlook)
Stack Overflow: Display email body of selected email in Outlook as a message box in Excel
MSDN: Introduction to Outlook VBA
NoProofing should work as intended.
Option Explicit
Private Sub Proofing_EnglishUK()
Dim oMailItm As Object
Dim oInsp As Object
Dim oMailEd As Object
Dim oWord As Object
Dim Rng As Object
Set oInsp = ActiveInspector
If oInsp.currentItem.Class = olMail Then
Set oMailItm = oInsp.currentItem
If oInsp.EditorType = olEditorWord Then
Set oMailEd = oMailItm.GetInspector.WordEditor
Set oWord = oMailEd.Application
Set Rng = oWord.Selection
Rng.WholeStory
With Rng
.LanguageID = wdEnglishUK
' This should work as intended
'.NoProofing = False
' ******* temporary *************
' Check whether .NoProofing can be set
' with a spelling error somewhere in the mail
.NoProofing = Not .NoProofing
If .NoProofing = False Then
MsgBox "Proofing on. Errors should be found."
Else
MsgBox "Proofing off. The errors will not be found."
End If
' ******* temporary *************
End With
oMailItm.Save
End If
End If
Set Rng = Nothing
Set oWord = Nothing
Set oMailEd = Nothing
Set oMailItm = Nothing
End Sub

Integrating automatic adding of reference into sub (vba)

How do I integrate my code that activates a reference (if it's not already activated) into the beginning of a code I've already got? The problem seems to be the newly added reference isn't recognized as active if I try activating and calling them within the same sub... any suggestions? When I run them separately they run just fine. I'm getting a 4120 Run-time Error (bad parameter) which also happens when reference isn't activated
Sub test ()
Dim strGUID As String, theRef As Variant, i As Long
'Update the GUID you need below.
strGUID = "{00020905-0000-0000-C000-000000000046}"
'Remove any missing references
For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
Set theRef = ThisWorkbook.VBProject.References.Item(i)
If theRef.isbroken = True Then
ThisWorkbook.VBProject.References.Remove theRef
End If
'Check if the reference isn't already activatet - can cause issues when stepping through but works just fine
If ThisWorkbook.VBProject.References.Item(i).GUID = strGUID Then
GoTo ContinueSub
End If
Next i
'Add the reference
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUID, Major:=1, Minor:=0
Run "ContractPrep"
ContinueSub:
Dim wdApp As Object, wdDoc As Object
'Bunch of code here and then the error occurs here:
Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Open(Temp)
'show the word document - put outside of loop for speed later
wdApp.Visible = True
wdDoc.Application.Selection.Wholestory
openxml = wdDoc.Application.Selection.WordOpenXML
wdDoc.Application.Selection.Delete
'Rest of code
End Sub

VBA, MS Outlook, Folder Item

I want to implement an VBA application, which uses the selected object (E-mail, task, folder).
My try with Application.ActiveExplorer.Selection.Item(i_item) seems to return only mails, tasks, calender entries or notes but never an folder (e.g. 'Inbox\').
When the user selects an e-mail, and then starts the VBA macro, the solution Application.ActiveExplorer.Selection.Item(i_item) delivers the desired results.
However, if the last item picked by the Outlook user was an folder (e.g. 'Sent Mails'). And the VBA makro started afterward, than the macro should recive the Folder Item (without additional user interaction). This is currently not the case. The code above still delivers the e-mail, or task.
How do I check, if the last selection was on an folder (not an e-mail, etc)?
How do I access the Folder item?
If this is not possible I will switch back to Pickfolder (like proposd by Darren Bartrup-Cook) but this is not me prefred solution.
I want to get the selected folder in order to change its icon, so our code is somehow the same.
I noticed that Application.ActiveExplorer.Selection.Item(i_item) it is not perfect, since it throws an exception for empty folders or on calendar etc.
So I use Application.ActiveExplorer.CurrentFolder.DefaultMessageClass (Application.ActiveExplorer.NavigationPane.CurrentModule.Name or Application.ActiveExplorer.NavigationPane.CurrentModule.NavigationModuleType) in order to figure out where I actually am.
By that approach it is easy to get current selected folder
Dim folder As Outlook.MAPIFolder
Dim folderPath As String, currItemType As String
Dim i As Integer
currItemType = Application.ActiveExplorer.CurrentFolder.DefaultMessageClass
If currItemType = "IPM.Note" Then 'mail Item types https://msdn.microsoft.com/en-us/library/office/ff861573.aspx
Set folder = Application.ActiveExplorer.CurrentFolder
folderPath = folder.Name
Do Until folder.Parent = "Mapi"
Set folder = folder.Parent
folderPath = folder.Name & "\" & folderPath
Loop
Debug.Print folderPath
End If
haven't got an problem with it yet. In your case, you can store the selection in a global variable, so you always know which folder was selected last.
This procedure will ask you to select the folder.
If you interrupt the code and examine the mFolderSelected or MySelectedFolder then you should be able to work something out:
Public Sub Test()
Dim MySelectedFolder As Variant
Set MySelectedFolder = PickFolder
End Sub
Public Function PickFolder() As Object
Dim oOutlook As Object 'Outlook.Application
Dim nNameSpace As Object 'Outlook.Namespace
Dim mFolderSelected As Object 'Outlook.MAPIFolder
On Error GoTo ERROR_HANDLER
Set oOutlook = CreateObject("Outlook.Application")
Set nNameSpace = oOutlook.GetNameSpace("MAPI")
Set mFolderSelected = nNameSpace.PickFolder
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The commented out code will return only email folders. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not mFolderSelected Is Nothing Then
' If mFolderSelected.DefaultItemType = 0 Then
Set PickFolder = mFolderSelected
' Else
' Set PickFolder = Nothing
' End If
Else
Set PickFolder = Nothing
End If
Set nNameSpace = Nothing
Set oOutlook = Nothing
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure PickFolder."
Err.Clear
End Select
End Function
NB: This was written to be used in Excel and has late binding - you'll need to update it to work in Outlook (no need to reference Outlook for a start).

How to write VBA code that works in multiple Office apps

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?