I'm using a COM interface to export animations from a third-party program. I'm sending an exporting COM command with script from my tool with a shell command.
There's a problem with when I send the animation export command to the third-party tool. It starts to export, but my tool is sending a second animation export command while the last one is not finished. How can I prevent from this situation?
I'd like to sending my shell command from the for loop after the file was created.
My code is like below.
Private Sub tlbCheckSolveEvaCtrl_exportmodeshape_Click(sender As Object, e As EventArgs) Handles tlbCheckSolveEvaCtrl_exportmodeshape.Click
Try
Dim strArgument As String
Dim strfilePathEV As String
Dim strfilePathANI As String
Dim strfilePathPIC As String
strfilePathEV = strProjMdlDir & My.Settings.txtCheckSolverOuputDir & strProjMdlName & ".ev.sbr"
strfilePathANI = strProjMdlDir & "\" & My.Settings.txtProjDirDOC & "\" & My.Settings.txtProjDirANI & "\"
strfilePathPIC = strProjMdlDir & "\" & My.Settings.txtProjDirDOC & "\" & My.Settings.txtProjDirPIC & "\"
For i As Integer = 0 To dgvCheckSolveEva.RowCount - 1
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Shell(My.Settings.txtSpckDir & "simpack-post.exe -s qs_mode_shape.qs " & strArgument)
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
I'd like to continue my for loop if strfilePathANI & strProjMdlName & "_" & i & ".mpg", the animation file was created, so I can start to export the next one.
The best way would be to use the .NET Process class and call the WaitForExit() method in order to wait for simpack-post.exe to close itself.
Shell() is an outdated function from the VB6-era which exists purely for partial backwards compatibility with that language. It shouldn't be used in new code.
Basic example:
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
The problem with this of course is that it might block the UI thread and thus cause it to freeze, depending on how long it takes for the process to exit. Therefore we should wrap it in a Task:
Dim c As Integer = dgvCheckSolveEva.RowCount - 1
Task.Run( _
Sub()
For i As Integer = 0 To c
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
Next
End Sub _
)
Just note that you cannot directly access the UI from within the task. If you want to do so you need to Invoke.
EDIT:
If you are targeting .NET Framework 3.5 or lower, or using VS 2008 or lower, tasks aren't available and we have to resort to using regular threads and/or regular methods instead of lamba expressions.
Note that the same rules apply, though - you cannot access the UI without invoking.
.NET 3.5 (or lower) using VS 2010 (and higher):
Dim c As Integer = dgvCheckSolveEva.RowCount - 1
Dim t As New Thread( _
Sub()
For i As Integer = 0 To c
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
Next
End Sub _
)
t.IsBackground = True
t.Start()
.NET 3.5 (or lower) using VS 2008 (or lower):
Private Sub tlbCheckSolveEvaCtrl_exportmodeshape_Click(sender As Object, e As EventArgs) Handles tlbCheckSolveEvaCtrl_exportmodeshape.Click
...your code...
Dim c As Integer = dgvCheckSolveEva.RowCount - 1
Dim t As New Thread(New ParameterizedThreadStart(AddressOf ExportAnimationsThread))
t.IsBackground = True
t.Start(c)
...your code...
End Sub
Private Sub ExportAnimationsThread(ByVal Count As Integer)
For i As Integer = 0 To Count
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
Next
End Sub
Related
So. I have an image that can be set as the background image on my vb app and when the user wants to change the image, I have it so that it fetches their chosen image from a showdialog and puts it into a specific filepath for the rest of the program to access. But, when the process is done more than once on its initial run (meaning there is no image in the directory yet) it gives and error saying the process cannot be completed due to ("C:\userdata" & ProteusLogin.txtUsername.Text & "" & "backgroundimage.jpg", "delete.jpg") process being in use.
Here is the code.
Private Sub RDBCustom_doubleclick(sender As Object, e As EventArgs) Handles RDBCustom.Click
RBLight.Checked = False
RBOriginal.Checked = False
RBDark.Checked = False
Dim openfiledialog1 As New OpenFileDialog
Try
My.Computer.FileSystem.CopyFile(openfiledialog1.FileName, "C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "backgroundimage.jpg")
Catch
If System.IO.File.Exists("C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "backgroundimage.jpg") = True Then
My.Computer.FileSystem.RenameFile("C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "backgroundimage.jpg", "delete.jpg")
System.IO.File.Delete("C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "delete.jpg")
My.Computer.FileSystem.CopyFile(openfiledialog1.FileName, "C:\userdata\" & ProteusLogin.txtUsername.Text & "\" & "backgroundimage.jpg")
End If
End Try
End Sub
i would like to call an Octave script from VBA with a batch file and passing some arguments to it.
The Octave script creates a .csv file which is needed in the VBA code later on.
The Problem is, that the VBA code doesn't wait for Octave creating the .csv file and i get an error message that the file is not there. So i need a way to wait until Octave has created the file.
Here is my VBA code:
Public Sub LinkOctave(ByVal Projekt As String, ByVal Winddaten As String, ByVal Ak As String, ByVal Typ As String, _
ByVal Anz As Double, ByVal NH As Double, ByVal Netto As Double, _
ByVal StartGW As Double, ByVal EndGW As Double, _
ByVal StartP As Double, ByVal EndP As Double)
Dim PID As Variant
Dim BatchFilePath As String
Dim ProjektBat As String
Dim WinddatenBat As String
Dim AkBat As String
Dim TypBat As String
Dim AnzBat As Double
Dim NHBat As String
Dim NettoBat As String
Dim StartGWBat As String
Dim EndGWBat As String
Dim StartPBat As String
Dim EndPBat As String
ProjektBat = "'" & Projekt & "'"
WinddatenBat = "'" & Winddaten & "'"
AkBat = "'" & Ak & "'"
TypBat = "'" & Typ & "'"
AnzBat = Anz
NHBat = str(NH)
NettoBat = str(Netto)
StartGWBat = str(StartGW)
EndGWBat = str(EndGW)
StartPBat = str(StartP)
EndPBat = str(EndP)
BatchFilePath = "C:\Users\bla\Documents\Octave\PFM\runfctPFM.bat"
PID = Shell(BatchFilePath & " " & ProjektBat & " " & WinddatenBat & " " & AkBat & " " & _
TypBat & " " & AnzBat & " " & NHBat & " " & NettoBat & " " & StartGWBat & " " & _
EndGWBat & " " & StartPBat & " " & EndPBat)
End Sub
I already found the way to do it with wsh.Run like this:
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Dim lngErrorCode As Long
lngErrorCode = wsh.Run(BatchFilePath & " " & ProjektBat & " " & WinddatenBat & " " & AkBat & " " & _
TypBat & " " & AnzBat & " " & NHBat & " " & NettoBat & " " & StartGWBat & " " & _
EndGWBat & " " & StartPBat & " " & EndPBat, windowStyle, waitOnReturn)
If lngErrorCode <> 0 Then
MsgBox "Something went wrong with the batch file!"
Exit Sub
End If
But it still doesn't wait for Octave to finish.
What did i wrong? Or is there another solution?
This is the code of the bat file, where i call the octave script:
#echo off
set OCT_HOME=C:\Octave\Octave-5.1.0.0\mingw64\
set "PATH=%OCT_HOME%\bin;%PATH%"
set SCRIPTS_DIR=%~dp0
set ProjektBat=%1
set WinddatenBat=%2
set AkBat=%3
set TypBat=%4
set AnzBat=%5
set NHBat=%6
set NettoBat=%7
set StartGWBat=%8
set EndGWBat=%9
shift /1
set StartPBat=%9
shift /1
set EndPBat=%9
start octave-cli.exe --eval "cd(getenv('SCRIPTS_DIR')); fctPFM(%ProjektBat%, %WinddatenBat%, %AkBat%, %TypBat%, %AnzBat%, %NHBat%, %NettoBat%, %StartGWBat%, %EndGWBat%, %StartPBat%, %EndPBat%); quit;"
Thanks for your support
Cheers
The bat file has a 'start' command in it which according to the Microsoft docs opens a separate command prompt for the command - so its not going to wait for the separate command window to finish.
https://learn.microsoft.com/en-us/windows-server/administration/windows-commands/start
Note also in windows, you should probably not be calling the octave executables directly, rather use the .bat files that come with it, as they set up expected environment variables in order for octave to run correctly.
A report is called from VBA to receive returned records from an Access pass-through query. After the DoCmd completes the report's parameters are set in the report's appropriate label containers setting their .Caption property as required. Access fails intermittently during this process which leads me to believe that the report is not truly open to receive the parameters. Here's the VBA sub:
Private Sub Report_Open(Cancel As Integer)
Dim strFromDate As String
Dim strToDate As String
Dim strWC As String
Dim intShift As Integer
Dim strSQL As String
strFromDate = InputBox("Enter From Date and Time: ")
strToDate = InputBox("Enter To Date and Time: ")
strWC = InputBox("Enter Work Center: ")
intShift = InputBox("Enter Shift: ")
strSQL = "exec dbo.uspWorkCentreReport_TEST " & "'" & strFromDate & "', " & "'" & strToDate & "', " & "'" & strWC & "', " & intShift & ";"
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQL
DoCmd.OpenReport "rpt_qry_ptq_uspWorkCentreReport", acViewReport
Me.lblFromDate.Caption = strFromDate
Me.lblToDate.Caption = strToDate
Me.lblWC.Caption = strWC
Me.lblShift.Caption = intShift
End Sub
When the failure occurrs VBA highlights the Me.lblFromDate.Caption = strFromDate. If I press Reset in VBA or End on the Run-time error '2467': dialog, Access abends without any other outward signs. Access then re-opens to save the copied *_Backupx.accdb and opens with a fresh copy of the .accdb. The error seems to be a standars MS error:
As I said the report is intermittent and when it fails VB always highlights the same line in code. How do I capture what is happening or can I make VB wait a half of full second before it tries to write the parameters?
As I remember, captions can not be modified, when report open. Only in design mode. So this is not correct, because you have already opened report
Me.lblFromDate.Caption = strFromDate
You should use text boxes instead of captions. Also you can clear the borders, fillings and so on, that text box will appear like a caption.
Finally the correct set of code was produced. The button click creates strOpenArgs and passes it with .OpenReport. The report opens and splits the OpenArgs and populates the appropriate labels with updated Captions. Text boxes would not work! Here's the button click event:
Private Sub btnPreviewP1_Click()
If (Me.txtToDateP1 < Me.txtFromDateP1) Then
MsgBox ("The From Date must occurr before the To Date!")
End If
Dim strFromDateHMS As String
Dim strToDateHMS As String
Dim strSQLP1 As String
Dim strOpenArgs As String
strFromDateHMS = Format(Me.txtFromDateP1, "yyyy-mm-dd") & " " & Me.cboFromHourP1 & ":" & Me.cboFromMinuteP1 & ":" & Me.cboFromSecondP1
strToDateHMS = Format(Me.txtToDateP1, "yyyy-mm-dd") & " " & Me.cboToHourP1 & ":" & Me.cboToMinuteP1 & ":" & Me.cboToSecondP1
strSQLP1 = "exec dbo.uspWorkCentreReport '" & strFromDateHMS & "','" & strToDateHMS & "','" & strWCP1 & "'," & strShiftP1
strOpenArgs = Me.RecordSource & "|" & strFromDateHMS & "|" & strToDateHMS & "|" & strWCP1 & "|" & strShiftP1
' This line is all that's needed to modify the PT query
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQLP1
DoCmd.OpenReport "rpt_ptq_uspWorkCentreReport", acViewReport, , , , strOpenArgs
End Sub
And here's the reports _Open:
Private Sub Report_Open(Cancel As Integer)
Dim SplitOpenArgs() As String
SplitOpenArgs = Split(Me.OpenArgs, "|")
Me.lblFromDate.Caption = SplitOpenArgs(1)
Me.lblToDate.Caption = SplitOpenArgs(2)
Me.lblWC.Caption = SplitOpenArgs(3)
Me.lblShift.Caption = SplitOpenArgs(4)
End Sub
This opens the report every time with new appropriate data, so long as the report is closed before the form's button is pressed again for another refresh of the report. If the report is not closed the report stays up with the original data and does not refresh with new data... But that is another question I am about to ask. Thanks All.
I am using MS Access Forms and I am trying to open a file but don't know how to open the file based knowing only part of the name. Example below works
Private Sub Open_Email_Click()
On Error GoTo Err_cmdExplore_Click
Dim x As Long
Dim strFileName As String
strFileName = "C:\data\office\policy num\20180926 S Sales 112.32.msg"
strApp = """C:\Program Files\Microsoft Office\Office15\Outlook.exe"""
If InStr(strFileName, " ") > 0 Then strFileName = """" & strFileName & """"
x = Shell(strApp & " /f " & strFileName)
Exit_cmdExplore_Click:
Exit Sub
Err_cmdExplore_Click:
MsgBox Err.Description
Resume Exit_cmdExplore_Click
End Sub
If I change the strFilename to being
strFileName = "C:\data\" & Me.Office & "\" & Me.nm & " " & Me.pol & "\" & "*"& " S Sales " & Me.amt & "*" & ".msg"
It includes the * rather than using it as a wildcard, the date/numbers can be anything or in another format but always eight numbers. I tried using a while loop on the numbers but I am not sure the best way of doing this sorry.
You can use the Dir function to iterate over all files that match a string pattern.
strApp = """C:\Program Files\Microsoft Office\Office15\Outlook.exe"""
Dim strFilePattern As String
strFilePattern ="C:\data\" & Me.Office & "\" & Me.nm & " " & Me.pol & "\" & "*"& " S Sales " & Me.amt & "*" & ".msg"
Dim strFileName As String
strFileName = Dir(strFilePattern)
Do While Not strFileName = vbNullString
If InStr(strFileName, " ") > 0 Then strFileName = """" & strFileName & """"
x = Shell(strApp & " /f " & strFileName)
strFileName = Dir
Loop
The first call to Dir with the pattern as a parameter will find the first file that matches the pattern supplied. All subsequent calls without the pattern will return the next file that matches the pattern.
So, lets rebuild the question a bit. Imagine that you are having the following 5 files in a given folder:
A:\peter.msg
A:\bstack.msg
A:\coverflow.msg
A:\heter.msg
A:\beter.msg
and you need to find the files, that correspond to "A:\*eter.msg" and print them.
For this, you need to use the keyword Like:
Sub TestMe()
Dim someNames As Variant
someNames = Array("A:\peter.msg", "A:\bstack.msg", _
"A:\coverflow.msg", "A:\heter.msg", "A:\beter.msg")
Dim cnt As Long
For cnt = LBound(someNames) To UBound(someNames)
If someNames(cnt) Like "A:\*eter.msg" Then
Debug.Print someNames(cnt)
End If
Next
End Sub
Loop through files in a folder using VBA?
I generally use VB.Net for programming but I have been delegated to a VBA project that would benefit from using script control for running script. Here is sample code but errors out on the .Run line of code. I can do this in VB.Net easy but can't get it to work in vba.
ERROR = Wrong number of arguments or invalid property assignent
Option Explicit
Dim sc As New ScriptControl
Sub RunFunctions()
MsgBox (Eval("2 * PI"))
End Sub
Function Eval(expr As String) As Object
Dim code As String
code = "Dim PI" & vbCrLf & _
"PI = 3.1416" & vbCrLf & _
" " & vbCrLf & _
"Function Result" & vbCrLf & _
" Result = " & expr & vbCrLf & _
"End Function"
sc.Language = "VBScript"
sc.AllowUI = True
sc.AddCode (code)
Dim myparams() as variant
Eval = sc.Run("Result", myparams)
End Function
Using the .Eval function from the script control object runs ok in vba but does not run scripts. Here is an example of that if someone cares to know...
Sub SimpleTask()
Dim expr As String
sc.Language = "VBScript"
expr = "2 + 2 * 50"
MsgBox sc.Eval(expr)
End Sub
I think the issue is with your parameters to sc.Run. Try changing this call from
Eval = sc.Run("Result", myparams)
to
Eval = sc.Run("Result")
Update
Here is a complete form using your code that compiles and runs correctly:
Option Explicit On
Option Strict On
Imports MSScriptControl
Public Class Form1
Dim sc As New ScriptControl
Sub RunFunctions()
MsgBox(Eval("2 * PI"))
End Sub
Function Eval(expr As String) As Object
Dim code As String
code = "Dim PI" & vbCrLf & _
"PI = 3.1416" & vbCrLf & _
" " & vbCrLf & _
"Function Result" & vbCrLf & _
" Result = " & expr & vbCrLf & _
"End Function"
sc.Language = "VBScript"
sc.AllowUI = True
sc.AddCode(code)
Dim myparams() As Object
Eval = sc.Run("Result")
End Function
Sub SimpleTask()
Dim expr As String
sc.Language = "VBScript"
expr = "2 + 2 * 50"
MsgBox(sc.Eval(expr))
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
SimpleTask()
RunFunctions()
End Sub
End Class
Here is the final working code for VBA. competent_tech has one for VB.Net.
Option Explicit
Dim sc As New ScriptControl
Sub RunFunctions()
MsgBox (Eval("2 * PI"))
End Sub
Function Eval(expr As String) As String
Dim code As String
code = "Dim PI" & vbCrLf & _
"PI = 3.1416" & vbCrLf & _
" " & vbCrLf & _
"Function Result" & vbCrLf & _
" Result = " & expr & vbCrLf & _
"End Function"
sc.Language = "VBScript"
sc.AllowUI = True
sc.AddCode (code)
Eval = sc.Run("Result")
End Function