Excel VBA error using WScript.Shell.Run - vba

After recently upgrading from Excel 2010 to Excel 2013, I moved a custom add-in (.xlam) to the new Application.LibraryPath directory (C:\Program Files\Microsoft Office 15\root\office15\Library\BTRTools). There is a bit of code that launches an executable (exe) file (located in sub directory of the add-in). However, since the upgrade/move, I am not getting an error:
PrettyPrintXml.exe - Application Error
The application was unable to start correctly (0xc000007b). Click OK to close the application.
I'm obviously pretty convinced it is file permissions. I have explicitly added myself permissions with full rights to the \Library folder (and all subs). Note that I think I had to do this even with Excel 2010 (folder at C:\Program Files (x86)\Microsoft Office\Office14\Library) to make things work.
However, after all this, I'm still stuck and can not launch the exe file. Any ideas/suggestions on how to make this work?
Code is pretty standard:
Public Sub RunShellExecute(sFile As String, Optional params As String = "", Optional wait As Boolean = False)
Dim wsh As Object: Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = wait
Dim windowStyle As Integer: windowStyle = 1
Dim exe As String: exe = IIf(Left(sFile, 1) <> """", """" & sFile & """", sFile)
Dim exeParams As String: exeParams = IIf(params <> "", " " & params, "")
Dim errorCode As Integer: errorCode = wsh.Run(exe & exeParams, windowStyle, waitOnReturn)
If errorCode = 0 Then
'// MsgBox "Done! No error to report."
Else
MsgBox "Program exited with error code " & errorCode & "."
End If
End Sub

I know your question is "Why doesn't this work", but I thought you might be interested in an alternate solution: There is a native VBA PrettyPrintXML. You need to add a reference to the MSXML library in your VBA project by clicking "Tools" ---> "References..." and then check the box next to Microsoft XML, v6.0 (or whatever version is included with your version of Office/Windows).

Please change the title of your question, because Excel VBA is able to use WScript.Shell.Run, otherwise you wouldn't be getting your error.
As for the actual issue, this looks like a 32-bit / 64-bit problem. Investigate whether the program you're calling is appropriate for your system and whether it tries to load the right DLLs.
The problem is not file permissions, then you would get a different status code.

You should use a path without spaces in it, something simple like 'C:\BTRTools'. Then it should work.

Related

Copy file with progress bar bypass file replacement confirmation

This is a follow up to this question and great answer:
Copy files with progress bar
So I added the code from Siddharth Rout's answer and it does exactly what I want to happen with a minor exception. When I copy the files, I am looping through each file in the directory and copying it up as long as it is not *List.xml. Because I am replacing an existing library the 97% of the documents are pre-existing and I get prompted to replace existing documents each time.
Is there a way to get it to prompt me to choose to replace for all files? Do I need to reformat/structure the sequence of my code?
Function UploadToSharepoint(Folderpath As String, Foldername As String, Filenames() As String, SharepointLinks() As String) As Boolean
'upload file to sharepoint library based on the folder name
Dim SharePointLib As String
Dim LocalAddress As String
Dim DestinationAddress As String
Dim xCounter As Long
On Error GoTo loadFailed
Pickafolder:
Folderpath = FolderPick
Foldername = Left(Folderpath, Len(Folderpath) - 1)
Foldername = RIght(Foldername, Len(Foldername) - InStrRev(Foldername, "\"))
Select Case Foldername
Case "OPSS", "SSP", "OPSD", "MTOD", "SSD"
SharePointLib = "\\my.company.com\Subsite\" & Foldername & "\"
Case "West", "Eastern", "Northeastern", "Northwestern", "Head Office"
SharePointLib = "\\my.company.com\Subsite\NSP\" & Foldername & "\"
Case "NSP", "NSSP"
MsgBox "Pick the NSP regional sub folder: West, Eastern, Northeastern, Northwestern, Head Office"
GoTo Pickafolder
Case Else
MsgBox "Inappropriate directory to upload from. Please select one of the CPS download directories"
GoTo Pickafolder
End Select
Filenames = GetFilesDir(Folderpath)
ReDim SharepointLinks(LBound(Filenames) To UBound(Filenames))
For xCounter = LBound(Filenames) To UBound(Filenames)
LocalAddress = Folderpath & Filenames(xCounter)
DestinationAddress = SharePointLib & Filenames(xCounter)
'**********************************************************
Call VBCopyFolder(LocalAddress, DestinationAddress)
'**********************************************************
SharepointLinks(xCounter) = "#http:" & Replace(DestinationAddress, "\", "/") & "#"
Next xCounter
UploadToSharepoint = True
Exit Function
loadFailed:
UploadToSharepoint = False
End Function
And by the looks of things I am not excluding the file I was referring to earlier...must be doing that else where.
Update
Based on comment received at the linked question, the solution is to declare a public constant at the start:
Public Const FOF_NOCONFIRMATION As Long = &H10
and then in the copy procedure change the line of code to:
.fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION
Now, this does solve the problem of being constantly asked to confirm the replacement. I am very happy about this. The problem now is the progress window displays for the first file to be copied then disappears but fails to reappear for subsequent files. The remaining files still get copied and the prg carries on like it's supposed to. The whole point of the progress bar though was to let people know that "THINGS" were still happening in the background and now that is not happening. Is there something I need to adjust?
Update 2
After running my code and choosing a source directory on the network drive instead of the local computer, the copy window is popping up for every single file like I was expecting. I notice that sometimes the progress bar closes before reaching 100%. This leads me to believe that since the file sizes are so small that when it is copying from my local drive to sharepoint, the operation completes so fast that it does not have time to draw and update the progress window before its time to close it.

Compiling VB Code With CodeDom

Read up on it, couldn't find anything that worked for me.
Basically, I have a file called SourceCode.vb in my resources.
I'm trying to use:
Dim objCodeCompiler As System.CodeDom.Compiler.ICodeCompiler = New VBCodeProvider().CreateCompiler
Dim objCompilerParameters As New System.CodeDom.Compiler.CompilerParameters()
objCompilerParameters.ReferencedAssemblies.Add("System.dll")
objCompilerParameters.ReferencedAssemblies.Add("System.Windows.Forms.dll")
objCompilerParameters.ReferencedAssemblies.Add("Microsoft.VisualBasic.dll")
objCompilerParameters.ReferencedAssemblies.Add("System.Drawing.dll")
objCompilerParameters.ReferencedAssemblies.Add("System.Data.dll")
objCompilerParameters.ReferencedAssemblies.Add("System.Deployment.dll")
objCompilerParameters.ReferencedAssemblies.Add("System.Xml.dll")
objCompilerParameters.GenerateExecutable = True
objCompilerParameters.GenerateInMemory = False
objCompilerParameters.CompilerOptions = "/target:winexe"
objCompilerParameters.OutputAssembly = "C:\"
Dim strCode As String = My.Resources.SourceCode.ToString
Dim objCompileResults As System.CodeDom.Compiler.CompilerResults = objCodeCompiler.CompileAssemblyFromSource(objCompilerParameters, strCode)
If objCompileResults.Errors.HasErrors Then
MsgBox("Error: Line>" & objCompileResults.Errors(0).Line.ToString & ", " & objCompileResults.Errors(0).ErrorText)
Exit Sub
End If
I need it to compile the code and make the file and place it in C:\ - For some reason its not working. Error is:
error: line>0, no input sources specified
Any ideas? Thanks in advance.
Edit: Problem was that I needed to add an actual name for the file after the output. Thanks for the help Hans.
It's actually because you are setting OutputAssembly to a location when it expects an assembly name. It should be:
objCompilerParameters.OutputAssembly = "AssemblyName.exe"
If you want to set the location of the output assembly, add it to your compiler options.
objCompilerParameters.CompilerOptions = "/target:winexe /out:C:\\AssemblyName.exe"
Although, I believe if you want to write to the C: drive, you will need to run your program as administrator.

Outlook Not Running Visual Basic After Restart

So I have created a visual basic script in outlook that creates a random signature by pulling from Git.
The script works correctly but whenever I restart my machine the script doesn't run at all.
I fixed the issue by going to
"File"->"Options"->"Trust Center"->"Trust Center Settings..."->"Macro Settings"->"Enable all macros"
This let the VBA code work whenever I opened and closed Outlook but is there a better way to have the code work whenever I reopen Outlook or restart my machine.
I have tried to use
Private Sub Application_Startup()
MsgBox "Hi"
End Sub
While that code did work when I first put it in, whenever I restarted outlook it said it couldn't run because "Macros were disabled"
Here is my code for the random signature, anyway to have this work whenever I restart outlook or my machine? Or is the macro setting I edited the correct way to go?
Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
' Validate that the item sent is an email.
If Item.Class <> olMail Then Exit Sub
'These first variables is to find the file the .bat file created within the AppData folder
'Set enviro to %APPDATA%
Dim enviro As String
enviro = CStr(Environ("APPDATA"))
'Create a new variable that sets the file path for the RepoDir.txt
RepoPath = enviro & "\RepoDir.txt"
'Create a new variable to grab the line of text in RepoDir.txt
Dim RepoFilePath As String
Dim strFirstLine As String
'The new variable calls the RepoPath Variable, opens it and reads the first line of the file and copies it into a variable
RepoFilePath = RepoPath
Open RepoFilePath For Input As #1
Line Input #1, strFirstLine
Close #1
'The script runs a Shell command that opens the command line, cds to the Repo path within the str variable, does a git pull, and outputs the error level to a file in the temp directory
Shell ("cmd /c cd " & strFirstLine & " & git pull RandomSig & echo %ERRORLEVEL% > %TEMP%\gitPull.txt 2>&1")
'These second set of variables is to find the file the Shell command created within the TEMP folder
'Set enviro to %TEMP%
Dim Gitenviro As String
Gitenviro = CStr(Environ("TEMP"))
'Create a new variable that sets the file path for the RepoDir.txt
PullResult = Gitenviro & "\gitPull.txt"
'Create a new variable to grab the line of text in RepoDir.txt
Dim GitFilePath As String
Dim GitFirstLine As String
'The new variable calls the PullResult Variable, opens it and reads the first line of the file and copies it into a variable
GitFilePath = PullResult
Open GitFilePath For Input As #2
Line Input #2, GitFirstLine
Close #2
'MsgBox (GitFirstLine)
'The variable is checked to see if it does not equal 0, and if it doesn't the message is cancelled
If GitFirstLine <> 0 Then
MsgBox "There was an error when attempting to do the Git Pull, cancelling message"
Cancel = True
End If
Const SearchString = "%Random_Line%"
Dim QuotesFile As String
QuotesFile = strFirstLine & "quotes.txt"
If InStr(Item.Body, SearchString) Then
If FileOrDirExists(QuotesFile) = False Then
MsgBox ("Quotes file wasn't found! Canceling message")
Cancel = True
Else
Dim lines() As String
Dim numLines As Integer
numLines = 0
' Open the file for reading
Open QuotesFile For Input As #1
' Go over each line in the file and save it in the array + count it
Do Until EOF(1)
ReDim Preserve lines(numLines + 1)
Line Input #1, lines(numLines)
numLines = numLines + 1
Loop
Close #1
' Get the random line number
Dim randLine As Integer
randLine = Int(numLines * Rnd()) + 1
' Insert the random quote
Item.HTMLBody = Replace(Item.HTMLBody, SearchString, lines(randLine))
Item.HTMLBody = Replace(Item.HTMLBody, "%Random_Num%", randLine)
End If
End If
End Sub
Function FileOrDirExists(PathName As String)
Dim iTemp As Integer
On Error Resume Next
iTemp = GetAttr(PathName)
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
On Error GoTo 0
End Function
It’s highly recommended to leave your macro security setting to only allow self-sign certificate Macros,
Do not use the Low option or run all
Create a self-signing certificate
Go to Start > All Programs > Microsoft Office > Microsoft Office Tools, and then click Digital Certificate for VBA Projects.
In the Your certificate's name box, type in name for the certificate.
Click OK. then SelfCert Success message will appears, click OK.
Go to Developer tab > click Visual Basic. or ALT+F11
In Visual Basic Editor, go to Tools > Digital Signature.
Digital Signature dialog appears and click on Choose and you’ll get a screen to select a certificate. Now you can choose the certificate you just created.
Edit
locating SelfCert.exe
Go to Start menu and typing VBA should bring up the SelfCert.exe.
Alternative method of locating SelfCert.exe
if you Can’t find it in the Start Menu? then By default you can find SelfCert.exe in the following location
Windows 32-bit
C:\Program Files\Microsoft Office\Office <version number>
Windows 64-bit with Office 32-bit
C:\Program Files (x86)\Microsoft Office\Office <version number>
Windows 64-bit with Office 64-bit
C:\Program Files\Microsoft Office\Office <version number>
Office 365 (Subscription based or Click-to-Run version of Office 2013)
C:\Program Files\Microsoft Office 15\root\office15
If SelfCert.exe is not installed
Then run Office setup and choose Add or Remove Features.
With older versions of Office you’ll need to choose Custom installation and then Advanced customization.
Expand the Office Shared Features section and select Digital Certificate for VBA Projects to run from your computer.
Simply run SelfCert.exe after locating it.

Issue with an LPR Command in VB

I am creating a VB app which will "move" xls reports from a directory to a ReportSafe app. I am also working in an existing VB app which does just that, so I am using it for reference.
It isn't as simple as moving files from one directory to another, because ReportSafe requires an lpr command to tell it (ReportSafe) which file to pick up.
Here is what I have so far:
Imports System.IO
Module Module1
Sub Main()
''Declarations
Dim Files As ArrayList = New ArrayList()
Dim FileName As String
''Write All Files in *directory* to ReportSafe
Files.Clear()
Files.AddRange(Directory.GetFiles(*directory*))
For Each FileName In Files
Dim RPname As String
Dim RealName As String
RPname = FileName.ToString
RealName = "/"
RealName = RealName & RPname.Remove(0, 34)
Dim a As New Process
a.StartInfo.FileName = "C:\Windows\system32\lpr.exe"
a.StartInfo.Arguments = "-S*ServerName* -Plp -J" & Chr(34) & RealName & Chr(34) & " " & Chr(34) & RPname & Chr(34)
a.StartInfo.UseShellExecute = False
Next
End Sub
End Module
The whole lpr command/arguments are throwing me for a loop. I'm not sure if my question is specific to ReportSafe, and if that's the case, I may be out of luck here. I have pulled this code from the already existing app which moves reports to ReportSafe, and adjusted for my own use, but no luck so far.
FYI, I had to turn on LPR Monitor services to obtain to the lpr.exe
Questions:
What are the proper arguments to pass through to this lpr command?
Is there a problem with the logic that is causing the issue?
I continued to tinker and look at my reference code and discovered some flaws in logic:
For one, the report name I was passing did not include the complete file path.
Another thing is that I never started the process with a.Start(). Rookie mistakes for sure... haha

VBA Shell command always returns "File Not Found"

I'm using VBA for MS Access in order to link a small C# app to my database as a helper tool. I have tried a couple of different ideas from stackoverflow itself, including the ShellAndWait utility and another on that page.
I have a button on a form. When you click this button, it should run another application that I am currently storing in %APPDATA%/program/
This is the code that is currently active:
Private Sub BtnImport_Click()
Dim file As String
Dim hProcess as Long
file = Environ("APPDATA") & "\program\component_import.exe"
'This is the standard version, which apparently does nothing at this time.
hProcess = Shell(file, vbNormalFocus)
'This is the RunApplication version I got from here earlier. It ends
'with "Successfully returned -532462766
import_funcs.RunApplication(file)
'This is the ShellAndWait version, which gives me a "File not Found" error
import_funcs.ShellAndWait(file, 0, vbNormalFocus, AbandonWait)
End Sub
I had changed the original shell out for both the ShellAndWait module and another similar module. Neither of those options work any differently in terms of my application not starting.
I have double-checked that "file" is correct (It points to C:\Users\Me\AppData\Roaming\program\component_import.exe). I have double-checked to make sure that my app is in the correct location.
It runs fine if I double-click from file explorer. It says Run-time error '53': File not found. whenever I attempt to run it from MS Access.
Any suggestions?
Edit: As an aside, the path itself does not contain any spaces.
Edit: Added some additional code.
Link to first pastebin: RunApplication pastebin
Link to second pastebin: ShellAndWait pastebin
I found sometimes folder names with spaces throws error when using shell command.
eg: C:\My Folder\appl.exe
make it:
C:\MyFolder\appl.exe
Also can check for a valid path:
The following code checks the folder where chrome.exe residing and calling www.google.com from there by passing url as argument:
Public Sub Display_Google()
Dim chromePath As String
chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"
If FileExists(chromePath) Then
Shell (chromePath & " -url" & " " & "www.google.com"), vbMaximizedFocus
Else
chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Shell (chromePath & " -url" & " " & "www.google.com"), vbMaximizedFocus
End If
End Sub
Public Function FileExists(ByVal FileName As String) As Boolean
On Error Resume Next
FileExists = Not CBool(GetAttr(FileName) And (vbDirectory Or vbVolume))
On Error GoTo 0
End Function