Here is all the set of code. There is one module and the macform.
Module1 source code
=====================
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const MACOLA_CONN_STRING1 = "Provider=SQLOLEDB;Persistent Security Info=False;User ID="
Public Const MACOLA_CONN_STRING2 = ";Pwd=;Data Source="
Public Const MACOLA_CONN_STRING3 = ";Initial Catalog="
Public Const MACOLA_CONN_STRING4 = ";Integrated Security=SSPI;"
Public strOrderReportName As String
Public Const strAppVortexPath = "\\vor2k3srv08\Macola_Image_360\rpt\Vortex"
Public Const strAppRptPath = strAppVortexPath & "\DeployRpts"
Public Function ReadTextFile(FullPathName As String) As String
Dim intFile As Integer
Dim lngFileLen As Long
Dim DataArray As String
intFile = FreeFile()
lngFileLen = FileLen(FullPathName)
Open FullPathName For Binary As intFile
ReadTextFile = Input(lngFileLen, intFile)
Close #intFile
End Function
Public Function IfIsNull(vValue As Variant, vValueIfNull) As Variant
IfIsNull = IIf(IsNull(vValue), vValueIfNull, vValue)
End Function
' Start the indicated program and wait for it to finish, hiding while we wait.
Public Sub ShellAndWait(ByVal program_name As String, ByVal window_style As VbAppWinStyle)
Dim process_id As Long
Dim process_handle As Long
' Start the program.
On Error GoTo ShellError
process_id = Shell(program_name, window_style)
On Error GoTo 0
DoEvents
' Wait for the program to finish.
' Get the process handle.
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, INFINITE
CloseHandle process_handle
End If
Exit Sub
ShellError:
MsgBox "Error starting task " & txtProgram.Text & vbCrLf & _
Err.Description, vbOKOnly Or vbExclamation, "Error"
End Sub
Macform source code
===================
Option Explicit
Private MODULE_NAME As String
Private Sub ColorSelectionReport_Click()
Dim lsOrdType As String
If Len(Trim(OrderNo.Text)) > 0 Then
If isOrderExistInCC(False, lsOrdType) Then
strOrderReportName = strAppRptPath & "\" & _
"InstallationToolKit\v11\VOR_ColorSelectionReport.rpt"
Call ShellAndWait(strAppVortexPath & "\CRViewer_RA.exe " & _
strOrderReportName & "|" & Trim(ConnInfo.Server) & "|" & _
ConnInfo.Database & "|" & ConnInfo.User & "|" & _
"order_no|" & Trim(OrderNo.Text) & "|" & _
"order_type|" & lsOrdType, vbNormalFocus)
Shell (strAppVortexPath & "\AltTab.bat")
Else
MsgBox "No Color Choices found for this Order No!" & vbCrLf & _
"Please enter another Order Number", vbExclamation, "Cannot open the report"
End If
Else
If Len(Trim(OrderNo1.Text)) > 0 Then
If isOrderExistInCC(True, lsOrdType) Then
strOrderReportName = strAppRptPath & "\" & _
"InstallationToolKit\v11\VOR_ColorSelectionReport.rpt"
Call ShellAndWait(strAppVortexPath & "\CRViewer_RA.exe " & _
strOrderReportName & "|" & Trim(ConnInfo.Server) & "|" & _
ConnInfo.Database & "|" & ConnInfo.User & "|" & _
"order_no|" & Trim(OrderNo1.Text) & "|" & _
"order_type|" & lsOrdType, vbNormalFocus)
Shell (strAppVortexPath & "\AltTab.bat")
Else
MsgBox "No Color Choices found for this Order No!" & vbCrLf & _
"Please enter another Order Number", vbExclamation, "Cannot open the report"
End If
Else
MsgBox "Invalid Order Number!" & vbCrLf & _
"Please enter a valid Order Number", vbExclamation, "INVALID ORDER NUMBER"
End If
End If
End Sub
Private Function isOrderExistInCC(ByVal aHistoric As Boolean, ByRef aType As String) As Boolean
Dim Macola As New ADODB.Connection
Dim macrs As Recordset
Dim strSQL As String
Dim lbReturn As Boolean
On Error GoTo ErrorHandler
MODULE_NAME = "isOrderExistInCC()"
lbReturn = False
aType = ""
Set Macola = Nothing
Macola.ConnectionTimeout = 120
Macola.Open MACOLA_CONN_STRING1 & ConnInfo.User & MACOLA_CONN_STRING2 & Trim(ConnInfo.Server) & MACOLA_CONN_STRING3 & ConnInfo.Database & MACOLA_CONN_STRING4
If aHistoric Then
strSQL = "SELECT ord_type FROM VOR_ColorChoicesHstOrd " & _
"WHERE ord_no = '" & OrderNo.Text & "' " & _
"ORDER BY ord_type"
Else
strSQL = "SELECT ord_type FROM VOR_ColorChoicesOrdLin " & _
"WHERE ord_no = '" & OrderNo.Text & "' " & _
"ORDER BY ord_type"
End If
Set macrs = New ADODB.Recordset
macrs.Open strSQL, Macola, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not macrs.EOF Then
aType = macrs.Fields("ord_type")
lbReturn = True
End If
macrs.Close
Macola.Close
Set macrs = Nothing
Set Macola = Nothing
isOrderExistInCC = lbReturn
Exit Function
ErrorHandler:
MsgBox "Module Name: " & MODULE_NAME & vbCrLf & _
"Error No: " & Err.Number & vbCrLf & _
"Error Desc: " & Err.Description, vbCritical, _
"Vortex [Report Error to System Admin]"
isOrderExistInCC = False
End Function
Thank you!
