Passing a parameter to a subroutine - vba

I have a powerpoint file with the following macro:
Sub test(msg$)
MsgBox msg
End Sub
I have a vbscript file that looks like this:
Option Explicit
On Error Resume Next
RunMacro
Sub RunMacro()
Set ppApp = CreateObject("Powerpoint.Application")
Set ppPres = ppApp.Presentations.Open("test.pptm", 1)
ppApp.Run "test.pptm!test ""my message here"" "
ppApp.Quit
Set ppPres = Nothing
Set ppApp = Nothing
End Sub
But I can't seem to pass the string parameter to the macro (no message box shows up in PPT). I'm guessing something is wrong with the number of quotation marks, but I've tried every permutation I could think of and nothing works. If I hard-code the message in the macro everything works fine.
Related (tried these, with no luck)
How to call Run() with parameters
Shell.Run with arguments

When in doubt, read the documentation. You're confusing the (VBScript) WshShell.Run method with the (VBA) Application.Run method.
Change this:
ppApp.Run "test.pptm!test ""my message here"" "
into this:
ppApp.Run "test.pptm!test", "my message here"

Related

Custom Outlook Macro only runs in VBA editor

I've created a Macro based on a blog post that only successfully runs in the VBA editor. When I run it from Outlook itself, nothing happens. Maybe you can see something obvious that I'm missing.
Pressed Alt+F11 to open the editor.
Named the module and pasted in the code.
Compiled and run. The e-mail in question opened in HTML-format as expected.
Closed the editor and added the button to the toolbar I wanted. Nothing happens.
Returned to the VBA editor and run the code. It works as expected.
Closed and re-opened Outlook to try the button again. Nothing happens.
Here's the code, with a screenshot of the code in the editor to follow.
Sub ReplyInHtmlFormat()
Dim olSel As Selection
Dim oMail As MailItem
Dim oReply As MailItem
Set olSel = Application.ActiveExplorer.Selection
Set oMail = olSel.Item(1)
If oMail.BodyFormat = olFormatPlain Or olFormatRichText Or olFormatUnspecified Then
oMail.BodyFormat = olFormatHTML
oMail.Save
End If
Set oReply = oMail.Reply
oReply.Display
Set olSel = Nothing
Set oMail = Nothing
Set oReply = Nothing
End Sub
You may want to check the macro permissions to make sure it is allowed to run. I hope that helps! ;-)
Try to add MsgBox statement outside of any If statement and you will be able to understand whether it is actually running or not when you click a button added to the toolbar.
Also, I'd recommend adding an error-handling routine to the function:
Public Sub OnErrorDemo()
On Error GoTo ErrorHandler ' Enable error-handling routine.
Dim x, y, z As Integer
x = 50
y = 0
z = x / y ' Divide by ZERO Error Raises
ErrorHandler: ' Error-handling routine.
Select Case Err.Number ' Evaluate error number.
Case 10 ' Divide by zero error
MsgBox ("You attempted to divide by zero!")
Case Else
MsgBox "UNKNOWN ERROR - Error# " & Err.Number & " : " & Err.Description
End Select
Resume Next
End Sub
So, you will be aware of any issues if any.

Activate specific URL contained in an email message

I know virtually nothing about VBA but am attempting to learn. I am trying to assist a blind client who gets messages from a specific agency he uses to get freelance engagements. These messages have to be responded to almost instantly by clicking on an "Accept" link in the message or there is no chance of getting the job. Since he uses a screen reader this complicates matters.
I have tried to adapt what I've found at stackoverflow to take the message on receipt, triggered by a message rule, to invoke VBA code to dig out the URL and immediately activate it.
Sub LaunchURL(itm As MailItem)
Dim MsgBody As String
Dim AllMsgLines
Dim IndividualLine
Dim AllLineWords
Dim SingleWord
Dim MboxReply
MsgBody = itm.Body
AllMsgLines = Split(MsgBody, vbCrLf)
For Each IndividualLine In AllMsgLines
AllLineWords = Split(IndividualLine, " ")
For Each SingleWord In AllLineWords
If SingleWord Like "http://*" Then
MboxReply = MessageBox.Show("I've found a URL", "LaunchURL Script", MessageBoxButtons.OKCancel, MessageBoxIcon.Asterisk)
Set itm = Nothing
Exit Sub
End If
Next SingleWord
Next IndividualLine
Set itm = Nothing
End Sub
Private Sub TestLaunchURL()
Dim currItem As MailItem
Set currItem = ActiveInspector.CurrentItem
LaunchURL currItem
End Sub
The code above is what I've been experimenting with. I will actually replace the message box either with:
Shell ("C:\Program Files\Internet Explorer\IEXPLORE.EXE" & " " & SingleWord)
or
FollowHyperlink SingleWord
When I run this I get "Runtime Error 91: Object variable or With block variable not set". I've tried stepping into the code and from what I can tell the problem originates at the SET statement in the TestLaunchURL subroutine.
I am trying to snag the message I currently have focus on in my Outlook inbox and parse it apart for the first instance of "http://", at least at the moment.
Also, what would I expect to be getting back in "SingleWord" if I have a URL that has click-through text that is shown to the user tied to the actual URL itself? I might be able to exploit that to look for the word "Accept" just ahead of the URL itself were "Accept" the click through text.

VBA wscript.shell .close giving error

I am using the following code (as found here) in Word2010 to find the target path of a shortcut:
Function Getlnkpath(ByVal Lnk As String)
On Error Resume Next
With CreateObject("Wscript.Shell").CreateShortcut(Lnk)
Getlnkpath = .TargetPath
.Close
End With
End Function
Sub GetLinkPath()
MsgBox Getlnkpath("yourshortcutnamehere")
End Sub
When I run the code as shown (modified to use my shortcut name) I get the following error:
Run-time error '438':
Object doesn't support this property or method
and the .Close line is highlighted for debug. When I comment out .Close the script works fine.
Does this cause problems if the shell doesn't close? I've read that .Close isn't necessary for Wscript.Shell but can't confirm that.
There is no Close method to the shortcut object and that is why you are getting the error. This link lists basic operations of WScript.Shell.
If you are intending to dispose the shell object, the best way to do would be
Set objWshShell = WScript.CreateObject("WScript.Shell")
With objWshShell.CreateShortcut(Lnk)
.Save
Getlnkpath = .TargetPath
End With
Set objWshShell = Nothing
Posting this answer for anyone who is still stuck on trying to close the WScript.Shell Object after creating it and not able to find a solution.
My Vb Script :
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell", vbNothing)
wsh.Run "cmd.exe /C pause"
wsh.Run "taskkill /F /IM cmd.exe"

VBA function call: Excel Button vs VBS call

I'm struggling with a VBA Sub that is called by a button. This Sub opens an Configuration.xls Excel spreadsheet from a hard coded file path. A MsgBox tell me about the current workspace - the workspace changes from the current file to the just opened one. All is fine here.
I now want to execute this Sub from an outside batch that calls a VBS that calls the VBA Sub. The workspace after opening the Configuration.xls file remains the same and does not change to Configuration.xls. Additionally when calling the Sub by VBS the function gets executed twice - No clue why.
So my question is - why do I have different behaviors between the two calling mechanisms?
I simplified the code below as it shows the same behavior as my more complex real code.
Sub ReadConfiguration()
MsgBox ActiveWorkbook.Name
FileExcel = "D:\_Trash\VBA_VBS\Configuration.xls"
Workbooks.Open Filename:=FileExcel, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
strFileName = FunctionGetFileName(FileExcel)
MsgBox ActiveWorkbook.Name
On Error Resume Next
Set wBook = Workbooks(strFileName)
If Err Then
Exit Sub
End If
ActiveWorkbook.Close savechanges:=False
End Sub
'*****************************************************
Function FunctionGetFileName(FullPath As Variant)
Dim StrFind As String
Do Until Left(StrFind, 1) = "\"
iCount = iCount + 1
StrFind = Right(FullPath, iCount)
If iCount = Len(FullPath) Then Exit Do
Loop
FunctionGetFileName = Right(StrFind, Len(StrFind) - 1)
End Function
'*****************************************************
The VBS looks like this
Dim args, objExcel
Set args = WScript.Arguments
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open args(0)
objExcel.Visible = False
objExcel.Run "Module1.ReadConfiguration()"
objExcel.ActiveWorkbook.Close(0)
objExcel.Quit
I just want to let you know about the solution of this issue allthough I cannot explain completely. The solution is to get rid of the "()" behind the macro call. This has the effect that the VBS script is run twice and the Workbook 'scope' is mixed up.
So easy solution but still the question WHY- What do I tell the function additionally when adding the "()"?
Thanks for your help!
TheMadMatt

Excel VBA to Open Multiple Word files in a loop

I apologize in advance for the newbie question -- most of my VBA experience is in Excel, or Word to Excel. In this case, I am going from Excel to Word. I am trying to capture some data off of some Word forms and store it in an Excel file.
Right now, my code works for the first document in the folder, but after that, it hoses up with an automation error "the server threw an exception" (goo!)
Here is my code:
Dim objWordApp As Object
strCurFileName = Dir(strFilePath)
Set objWordApp = CreateObject("word.application")
objWordApp.Visible = True
Do While strCurFileName <> ""
objWordApp.documents.Open strFilePath & strCurFileName
objWordApp.activedocument.Unprotect password:="testcode"
{EXCEL PROCESSING HERE}
strCurFileName = Dir
objWordApp.activedocument.Close 0
Loop
objWordApp.Quit
Set objWordApp = Nothing
I notice that the code works fine if I quit the app and set the object = nothing within the loop. But the way it is now, it bombs-out on the second file in the folder on the "objWordApp.documents.Open strFilePath & strCurFileName" line.
Can I open and close Word documents in a loop without having to create the object over and over? It's really slow when I do it that way.
Thanks for the help -- I like your way much better. Unfortunately, I get the same result. The program dies the second time through the loop on the line that reads:
Set objWordDoc = objWordApp.Documents.Open(objFile.Path)
The error that I get is:
Run-time Error -2147417851 (80010105)
Automation Error
The server threw an exception.
I tried your code on regular word docs (not the ones I'm processing) and it worked fine. The docs I'm running have form fields and macros -- not sure if that makes a difference. I have set the macro security in Word to both "low" and "very high" to make sure the other macros don't interfere.
I just can't figure it out why it works for the first doc and then not the next. I even cloned the first doc but it made no difference.
Still no luck, though. The only thing I can get to work is if I completely wipe the objects and re-create them every time I want to open a file.
Set objFolder = FSO.GetFolder(strFilePath)
For Each objFile In objFolder.Files
Set objWordApp = CreateObject("word.application")
objWordApp.Visible = True
If Right(objFile.Name, 4) = ".doc" Then
Set objWordDoc = objWordApp.documents.Open(Filename:=objFile.Path, ConfirmConversions:=False, _
ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto)
[Process DOC]
objWordDoc.Close 0, 1
End If
Set objWordDoc = Nothing
objWordApp.Quit
Set objWordApp = Nothing
Next
I'm not sure why that works and why it won't work the other way. If I have to go this route, I can -- it just seems really slow and inefficient. Is this a bad idea?
I changed the Dir to a FileSystemObject (go to Tools\References and add Microsoft Scripting Runtime) and I was able to successfully open multiple files. If you are having problems, please describe the error you see in the debugger. Also, if you need to recurse into subdirectories, you will need to refactor this.
Private mobjWordApp As Word.Application
Sub Test()
ProcessDirectory "PathName"
End Sub
Property Get WordApp() As Word.Application
If mobjWordApp Is Nothing Then
Set mobjWordApp = CreateObject("Word.Application")
mobjWordApp.Visible = True
End If
Set WordApp = mobjWordApp
End Property
Sub CloseWordApp()
If Not (mobjWordApp Is Nothing) Then
On Error Resume Next
mobjWordApp.Quit
Set mobjWordApp = Nothing
End If
End Sub
Function GetWordDocument(FileName As String) As Word.Document
On Error Resume Next
Set GetWordDocument = WordApp.Documents.Open(FileName)
If Err.Number = &H80010105 Then
CloseWordApp
On Error GoTo 0
Set GetWordDocument = WordApp.Documents.Open(FileName)
End If
End Function
Sub ProcessDirectory(PathName As String)
Dim fso As New FileSystemObject
Dim objFile As File
Dim objFolder As Folder
Dim objWordDoc As Object
On Error Goto Err_Handler
Set objFolder = fso.GetFolder(PathName)
For Each objFile In objFolder.Files
If StrComp(Right(objFile.Name, 4), ".doc", vbTextCompare) = 0 Then
Set objWordDoc = GetWordDocument(objFile.Path)
' objWordDoc.Unprotect Password:="testcode" ' Need to check if it has Password?
ProcessDocument objWordDoc
objWordDoc.Close 0, 1
Set objWordDoc = Nothing
End If
Next
Exit_Handler:
CloseWordApp
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
'Resume Next ' or as above
End Sub
Sub ProcessDocument(objWordDoc As Document)
'{EXCEL PROCESSING HERE}'
End Sub
EDIT: I've added some error handling and a little refactoring although there is quite a bit more refactoring that could be done.
There must be something special about the documents you are opening. You might try using different parameters for opening the documents, such as:
Set objWordDoc = objWordApp.Documents.Open( _
FileName:=objFile.Path, ReadOnly:=True)
You may need to add Microsoft Word as a Reference, and if you do that then start using the Word constants (wdDoNotSaveChanges, etc.). Check out the help on Documents.Open and test different parameters.
Also, use the "Set Next Statement" from the Context Menu during debugging and maybe skip the first document and open the second document directly and see if there are issues.
EDIT: I've changed the code to close and reopen Word if you get the automation error you described. You may have to adjust the error numbers, or simply close Word on any error (If Err.Number <> 0 Then ...).
Again, something must be special about your documents (macros, protection, etc.) because this code works on the test cases I have tried. Have you tried manually opening the documents in Word in the same order as the script, updating information similar to your process script, and then closing the documents to see if Word does anything strange?
Closing the Word.Application won't hurt anything, but it will obviously significantly slower.