VBA Declaring arguments outside a function - excel

I have vba code which opens a word document based on a template and when finished, runs the code below:
Public Sub Destroy(doc As Word.Document, app As Word.Application)
If Not (doc Is Nothing) Then doc.Close SaveChanges:=wdDoNotSaveChanges
If app.Documents.Count = 0 Then app.Quit wdDoNotSaveChanges
Set app = Nothing
End Sub
(this means that the app only closes if there are no other documents open and doesnt leave a blank application loaded when finished either)
I would like to extend this to excel and possibly other applications in the future; but rather than write a separate function for every different application, I wondered if I could have one function do-it-all.
The problem I'm finding is the declaration of arguments "doc As Word.Document" and "app As Word.Application".... is there a way of declaring what "doc" and "app" are in the calling program, and then getting the type definition of them inside my function to decide what to do depending on what type of application I choose to destroy()?
Edit:
I'm happy with the code, but on running a quick test in the code below, I founf that byref and byval both didnt effect the value of myval:
Private Sub Command12_Click()
Dim myval As Integer
myval = 1
MsgBox "the value of myval is " & myval
doByVal (myval)
MsgBox "the value of myval is " & myval
doByRef (myval)
MsgBox "the value of myval is " & myval
End Sub
Private Sub doByVal(ByVal a As Integer)
a = a + 1
MsgBox "byVal gives " & a
End Sub
Private Sub doByRef(ByRef a As Integer)
a = a + 1
MsgBox "byRef gives " & a
End Sub

Sure. You may declare generic Objects as args of the function, and verify their actual type in function. Basically, your code frame will look like:
Public Sub Destroy(ByVal doc As Object, ByVal app As Object)
If (TypeOf doc Is Word.Document) And (TypeOf app Is Word.Application) Then
' Word related stuff
ElseIf (TypeOf doc Is Excel.Workbook) And (TypeOf app Is Excel.Application) Then
' Excel related stuff
' ...
Else
' Do something about mixed cases, unhandled types etc.
End If
End Sub
And here's passing args to Destroy function, as (a bit exaggerated) example:
Dim my_doc As Excel.Workbooks
Dim my_app As Excel.Application
Set my_app = Excel.Application
Set my_doc = my_app.Workbooks("IWantYouClosed.xlsx")
Call Destroy(my_doc, my_app)

You are trying to use Early binding, and that requires creating a reference to the appropriate library (in Tools, References).
Alternatively, you can use Late binding, declaring doc As Object.
The web has lots of pages on "early binding vs late binding". One sample here.

Using the help given, this is the code I am now using, hope this helps someone.
Public Sub Document(ByVal doc As Object, ByVal app As Object)
Select Case True
Case (TypeOf doc Is Word.Document And TypeOf app Is Word.Application)
If Not (doc Is Nothing) Then doc.Close SaveChanges:=wdDoNotSaveChanges
If app.Documents.Count = 0 Then app.Quit wdDoNotSaveChanges
Set app = Nothing
Case (TypeOf doc Is Workbook And TypeOf app Is Excel.Application)
'code for excel workbook
Case Else
MsgBox "Cannot recognise the document/application, or there may be a mismatch"
End Select
End Sub

Related

Assigning a With statement to one of two classes depending on a toggle, issues assigning New Object to be the same as another

I'm currently a bit stuck with the "Object Variable or With block variable not set error".
Still fairly new to using With statements to simplify my code, I have two instances on my Class "ContractSelection" Both existing instances (previousContract & currentContract) are both by this time in the code called as public variables, and set with values. In this Sub I am attempting to submit one piece of information depending whether they are looking at the current selection or the previous (a toggle in the userform).
Frankly I'm not sure if contractToUpdate = currentContract is even a valid statement, but i'm finding it difficult to simply google.
(in a Public Variable module)
Public currentContract As ContractSelection
Public previousContract As ContractSelection
(in Userform module)
Private Sub UserForm_Initialize()
Set currentContract = New ContractSelection
Set previousContract = New ContractSelection
End Sub
Values are set in general Subs like this
Sub setThePreviousContractAsTheCurrent()
currentContract.DistrictNumber = previousContract.DistrictNumber
currentContract.ContractName = previousContract.ContractName
currentContract.RegionName = previousContract.RegionName
'...
End Sub
(In a Main Sub module) This Sub is where the issue is.
Sub submitNewCode()
Dim contractToUpdate As ContractSelection, response As Integer
Set contractToUpdate = New ContractSelection
If CDBENC_Form.chkbx_PreviousSearch.value = False Then
'vba stating the issue is here
contractToUpdate = currentContract
Else
contractToUpdate = previousContract
End If
With contractToUpdate
If .CodeOfContract <> "" Then
If isSimilarByOne(.CodeOfContract, CDBENC_Form.txt_Code.value) = False Then
dataSheet.Cells(.TheRowIWasFoundIn, dataMappedColumns.CodeColumnNum).value = CDBENC_Form.txt_Code.value
Else
response = MsgBox("The new code is close to the original, is " & CDBENC_Form.txt_Code.value & " the intended new code?", vbYesNo + vbQuestion, "Confirm Action")
If response = vbYes Then
dataSheet.Cells(.TheRowIWasFoundIn, dataMappedColumns.CodeColumnNum).value = CDBENC_Form.txt_Code.value
Else
Exit Sub
End If
End If
End If
End With
End Sub
I've tried checking for to see if for some reason currentContract is showing as nothing
this returns the else
If currentContract Is Nothing Then
MsgBox "Current Contract is nothing"
Exit Function
Else
MsgBox "Current Contract is not nothing"
End If
I've tried both
Dim contractToUpdate As ContractSelection
Dim contractToUpdate As New ContractSelection
also putting in the public variables as well
Public contractToUpdate As New ContractSelection
Any suggestions help, I feel as though I'm close to the idea but far from the solution.
VBA requires the use of Set when assigning a value to an object-typed variable.
So:
If CDBENC_Form.chkbx_PreviousSearch.value = False Then
Set contractToUpdate = currentContract
Else
Set contractToUpdate = previousContract
End If
If you're interested in why that's the case: https://stackoverflow.com/a/9924325/478884

Writing from Excel, to Word Activex Text box

I have an Excel application which collects information via a form based interface. This is used to;
Fill values in the workbook
A procedure opens a Word document (template essentially) and names the file according to rules, based
on some of the input data. (Okay to this point)
The idea then, is to transfer collected information (from the Excel app driving this process) to
the same Word document opened and named.
Specifically, I intend to populate a number of uniquely named ActiveX textboxes with document.
*** This is where I fail miserably.
I have enabled the "Microsoft Word 16.0 Object Library" under references in the MSExcel VBA environment.
Given that I know the name/title of the content control (ActiveX textbox is a 'content control' isn't it?). The code below is a simplified example, if it works for the example I should be able to sort out the broader document:
Sub trial()
Dim Word As Word.Application
Dim wdDoc As Word.Document
On error resume next
Set Word = New Word.Application
Set wdDoc = Word.Documents.Open("G:\CAPS Management Tool\Customer.docm")
Word.Application.Visible = True
Dim cc As Object
Set cc = ActiveDocument.SelectContentControlsByTitle(txt_PersonName) 'txt_PersonName is the control name
cc.Range.Text = "SUCCESS" 'Run-time error 438
'Object does not support property or method
Set cc = ActiveDocument.SelectContentControlsByTitle(txt_Address) 'txt_Address is the control name
cc.Range.Text = "SUCCESS" 'Run-time error 438
'Object does not support property or method
End Sub
Anybody able to assist? There are a lot of text boxes in the Word document I wish to plug in to.
Thanks in advance.
OK, so I kept digging (I don't like accepting defeat) and found that my entire premise was wrong! ActiveX controls in Word are considered "InlineShapes" not "ContentControls". But the results I was reading in the internet searches had me confused (didn't claim to be the sharpest tool in the shed).
Once I realised this, some more digging provided the answer (see below).
So, first to list the 3 controls in my document (and their index) with the following Sub
Sub ListActiveXControls()
Dim i As Integer
i = 1
Do Until i > ActiveDocument.InlineShapes.Count
Debug.Print ActiveDocument.InlineShapes(i).OLEFormat.Object.Name & " Control Index = " & i
i = i + 1
Loop
End Sub
Now moving to EXCEL, I used the following:
Sub trial()
Dim Word As Word.Application
Dim wdDoc As Word.Document
Set Word = New Word.Application
Set wdDoc = Word.Documents.Open("G:\CAPS Management Tool\Customer.docm")
Word.Application.Visible = True
debug.print "ActiveDocument Name is : " & ActiveDocument.Name
' Result = Nothing
' Allowing the code to continue without the pause caused the operation to fail
Application.Wait (Now + TimeValue("0:00:10")) ' See text below, would not work without pause
wdDoc.Activate
' Begin set ActiveX control values. In this instance,
' The first line corresponds to 'Textbox1'
ActiveDocument.InlineShapes(1).OLEFormat.Object.Text = "Success"
' The second line corresponds to 'Textbox2'
ActiveDocument.InlineShapes(2).OLEFormat.Object.Text = "Success"
' The third line corresponds to 'ChkBox1'
ActiveDocument.InlineShapes(3).OLEFormat.Object.Value = True
End Sub
For some reason, without the 'Wait' command, the operation fails. Stepping through, if there is no pause, the ActiveDocument seems to be null, no idea why. It occurs with a document with 2 ActiveX controls or 165 ActiveX controls and the wait required seems to
be 10 secs on my PC. Incidentally, setting almost 150 control values was only seconds, once the wait period was completed.
If anyone knows why the 'Wait' is seemingly required, I'd be interested to know!
Here are a few tips to help you work this out.
Don't use On Error Resume Next unless you really need it. And then when you do use it, re-enable error catching with On Error Goto 0 as quickly as possible. Otherwise you'll miss many errors in your code and it will be hard to tell what's happening.
Don't use the name Word as a variable name. It is reserved for the Word.Application and will only confuse the compiler (and you).
The control titles are text strings, so you must enclose them in double-quotes.
I've thrown in a bonus Sub that gives you a quick method to either open a new Word application instance or attach to an existing application instance. You'll find that (especially during debugging) there will be dozens of Word exe's opened and running.
The example code below also breaks the assignment of your "SUCCESS" value to the control into a separate Sub. It's in this short Sub that using On Error Resume Next is appropriate -- and isolated from the rest of the logic -- limiting its scope.
Option Explicit
Sub trial()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Set wdApp = AttachToMSWordApplication
Set wdDoc = wdApp.Documents.Open("C:\Temp\Customer.docm")
wdApp.Application.Visible = True
TextToControl wdDoc, "txt_PersonName", "SUCCESS"
TextToControl wdDoc, "txt_Address", "SUCCESS"
End Sub
Private Sub TextToControl(ByRef doc As Word.Document, _
ByVal title As String, _
ByVal value As String)
Dim cc As ContentControl
On Error Resume Next
Set cc = doc.SelectContentControlsByTitle(title).Item(1)
If Not cc Is Nothing Then
cc.Range.Text = value
Else
Debug.Print "ERROR: could not find control titled '" & title & "'"
'--- you could also raise an error here to be handled by the caller
End If
End Sub
Public Function AttachToMSWordApplication() As Word.Application
'--- finds an existing and running instance of MS Word, or starts
' the application if one is not already running
Dim msApp As Word.Application
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- we have to start one
' an exception will be raised if the application is not installed
Set msApp = CreateObject("Word.Application")
End If
Set AttachToMSWordApplication = msApp
End Function

Need to run a dummy VBA, SAPI code written by Microsoft but it is not clear how to make calls to those subroutines with arguments

Following code has been taken from the URL:
https://learn.microsoft.com/en-us/previous-versions/windows/desktop/ms720590(v=vs.85)
The page does attempt to tell something about it but it is vague.
The following code sample represents a simple, but functional, recognition application, using the in process (or InProc) recognizer. It uses a dictation grammar and allows free dictation. The commented lines refer to hypothetical labels in a form to possibly display information. To see the recognized phrase, add one label, named Label1. Of course you may modify this application as needed to fit your own requirements.
Before running the application, a speech reference must be included. Using the Project->References menu, find and select the Microsoft Speech Object Library.
An InProc recognizer requires additional lines that shared recognizers do not. For InProc recognizers, the audio object for either input or output must be explicitly assigned.
'Dim WithEvents RC As SpInProcRecoContext
Dim Recognizer As SpInprocRecognizer
Dim myGrammar As ISpeechRecoGrammar
Sub Form_Load()
On Error GoTo EH
Set RC = New SpInProcRecoContext
Set Recognizer = RC.Recognizer
Set myGrammar = RC.CreateGrammar
myGrammar.DictationSetState SGDSActive
Dim Category As SpObjectTokenCategory
Set Category = New SpObjectTokenCategory
Category.SetId SpeechCategoryAudioIn
Dim Token As SpObjectToken
Set Token = New SpObjectToken
Token.SetId Category.Default()
Set Recognizer.AudioInput = Token
EH:
If Err.Number Then ShowErrMsg
End Sub
Sub RC_Recognition(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal RecognitionType As SpeechLib.SpeechRecognitionType, ByVal Result As SpeechLib.ISpeechRecoResult)
On Error GoTo EH
Range("G8").Value = Result.PhraseInfo.GetText
EH:
If Err.Number Then ShowErrMsg
End Sub
Private Sub ShowErrMsg()
' Declare identifiers:
Const NL = vbNewLine
Dim T As String
T = "Desc: " & Err.Description & NL
T = T & "Err #: " & Err.Number
MsgBox T, vbExclamation, "Run-Time Error"
End
End Sub
Sub MyMacro()
Call Form_Load
Call RC_Recognition
End Sub````
Not able figure out how to call subroutine "RC_Recognition" that is taking some arguments.
the Dim WithEvents RC As SpInProcRecoContext line is the key. This automatically maps the function RC_Recognition as the handler for the Recognition event.

Can't work on Word CommandButton object from within Excel

I'm writing an Excel macro that opens up a Word document and looks for a CommandButton object, by Name. When it finds the object, it tries to check if it has a picture associated with it. It seems to be locating the object, but dies a "catastrophic" death when I try to reference the handle of the picture. I've done this before and looking to see if the picture's handle is zero has worked for me. Not sure what's up here, maybe someone else can see what I'm missing?
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(strFileName)
objWord.Visible = True
Set cmdSignatureButton = fncGetCommandButtonByName("NameOfCommandButtonImLookingFor", objDoc)
MsgBox "h=" & cmdSignatureButton.Picture.Handle
' It dies here, giving the error:
' Runtime error -2147418113 (8000ffff)
' Automation error
' Catastrophic failure
Private Function fncGetCommandButtonByName(strName As String, objDoc As Word.Document)
Dim obj As Object
Dim i As Integer
For i = objDoc.InlineShapes.Count To 1 Step -1
With objDoc.InlineShapes(i)
If .Type = 5 Then
If .OLEFormat.Object.Name = strName Then
Set fncGetCommandButtonByName = .OLEFormat.Object
MsgBox "Found the Command Button object" ' Seems to find the CommandButton object here
Exit Function
End If
End If
End With
Next
End Function
I was able to get this functioning without an issue. You may want to step through the code to see if the document is fully loaded first.
Here's the code that's working for me, edited to match the format of the original question posed.
Dim objWord As Object: Set objWord = CreateObject("Word.Application")
Dim objDoc As Object: Set objDoc = objWord.Documents.Open(strFileName)
objWord.Visible = True
Dim cmdSignatureButton As Object
Set cmdSignatureButton = fncGetCommandButtonByName("CommandButton1", objDoc)
If Not cmdSignatureButton Is Nothing Then
'Do something when it isn't nothing
MsgBox "h=" & cmdSignatureButton.Picture.Handle
Else
'Something here
End If
Private Function fncGetCommandButtonByName(strName As String, objDoc As Word.Document) As Object
Dim i As Integer
For i = objDoc.InlineShapes.Count To 1 Step -1
With objDoc.InlineShapes(i)
If .Type = 5 Then
If .OLEFormat.Object.Name = strName Then
Set fncGetCommandButtonByName = .OLEFormat.Object
Exit Function
End If
End If
End With
Next
Set fncGetCommandButtonByName = Nothing 'set it equal to nothing when it fails
End Function
If you are still receiving that error, I'm thinking it may have something to do with the picture not being fully loaded. If so, I'd add some error handling to catch that error and process a retry a second later to see if the picture's handle is available.
Here's what I get when I run that code:
OK, I think I have an approach, at least. I moved on to my next problem, which is very similar. In this case, I am looking for images within Command Buttons within an Excel spreadsheet, but I'm doing so from Access. Instead of trying to jump through hoops and get Access VBA to interrogate the Excel file, I put a Public Function into the Excel file that Access calls. Excel has no problem checking the button for an image, so it just returns the answer for me.
Had to figure out how to Run Public Functions, but that was easy enough. Thanks for the feedback, Ryan. Still not sure why yours worked and mine didn't, but at least I got around it.

VBA FileFolderExists pass variable

I found this function on a web
Private Function FileFolderExists(strFullPath As String) As Boolean
On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString then
FileFolderExists = True
End If
EarlyExit:
On Error GoTo 0
End Function
And I want to pass string variable like this
Dim lineText As String
...
ElseIf FileFolderExists(lineText) = False Then
I am getting compile error "byref argument type mismatch"
When I put byval before strFullPath, it doesn't seem to work properly.
I also tried playing with Dir function, it works if I pass literal like "C:\test", but it doesn't work if I pass the variable.
Does anyone have function that check for folder existence and accepts the string variable as parameter ?
Thanks in advance
The problem seems to be that Word adds CR character to every paragraph, or, to be more exact, that the Text property of the Paragraph object returns the paragraph text plus the CR character.
AFAIK, this is the Word's behaviour for every paragraph, even for the last one.
How can this cause a compile error, I do not have a clue. If I take Milan's example:
Private Sub FirstLineFolder()
Dim lineText As String
lineText = ActiveDocument.Paragraphs(1).Range.Text
lineText = Left(lineText, Len(lineText) - 1) 'see below
MsgBox DoesFolderExist("C:\")
MsgBox DoesFolderExist(lineText)
End Sub
it returns true, true if the first line of the document is a valid folder. If I comment the marked line, the program still compiles and runs and returns true, false (with the same document).
There is some info about it on MSDN website
Try this:
Function FolderExists(folderPath As String) As Boolean
Dim f As Object
Set f = CreateObject("Scripting.FileSystemObject")
On Error GoTo NotFound
Dim ff As Object
Set ff = f.GetFolder(folderPath)
FolderExists = True
Exit Function
NotFound:
FolderExists = False
On Error GoTo 0
End Function
I used the following to test it:
Sub Tst()
Dim b As Boolean
Dim s As String
s = "c:\temp"
b = FolderExists(s)
End Sub
And it works as expected.
Generally, I used Scripting.FileSystemObject for all file-related operation in VBA, the native functions are too cumbersome.
It should be also noted that my function all checks for folders, while the original function -- judging by its name -- perhaps also tried to check for existence of files.
New code, it explains exactly what I need, it should be easier for you to try.
I am expecting folder in first line of the Word document, then I have to check if it exists.
Private Sub FirstLineFolder()
Dim lineText As String
lineText = ActiveDocument.Paragraphs(1).range.Text
MsgBox DoesFolderExists("C:\") ' this works
MsgBox DoesFolderExists(lineText) ' this doesnt work, when same folder passed
End Sub
Both my and Martin's function are throwing compiling error I wrote in my first post.
If it matters : Word is 2010, "option explicit" isn't written (I inherited the code, I can't change that)

Resources