I want to simulate the enter key when my form opens so that it can continue it processes without the user having to push the enter key or selecting OK with the mouse. I know the question is then why have the form at all. I did not write the original code and have tried removing the form but then it takes over 10minutes for my program to fire up. If I leave the form on and I select the OK button, it takes about 30seconds. So I am hoping to create a workaround where it simulates that happening. I have pasted the code below...

I had been focusing on this part of the code (but maybe I am in the wrong area). I have also tried Sendkeys but that did not work.

If bOpened = True Then

Dim NewText As Boolean
NewText = True

Set Dialog = New UpdateWPNoteDialog


Dialog.Show vbModal

'Dialog.Hide

If Dialog.isOK Then
NewText = True
End If

Unload Dialog
Set Dialog = Nothing

End If

.....................................................

The full code of the dll is below......................................................

Option Explicit

Implements ILMForeignCalc
Implements IPrintValidation

Private Dialog As UpdateWPNoteDialog

Private Function ILMForeignCalc_DoCalculate(datasource As Llama.LMADataSource, Items As Llama.LMAItems, PropertyName As String, Value As Variant) As Boolean

End Function

'Creates a new file each time an event is fired
'File name is context type dependent
'Code has also been added for AutoGap and ExportLayer on Drawing Close Event

Private Function ILMForeignCalc_DoValidateItem(datasource As Llama.LMADataSource, Items As Llama.LMAItems, Context As LMForeignCalc.ENUM_LMAValidateContext) As Boolean

Dim sFileName As String
Dim strCurrentUser As String
Dim strDwgName As String
On Error GoTo ErrHndl

Dim bOpened As Boolean
bOpened = False

'Determine which event fired
Select Case Context
'Drawing Open
Case LMForeignCalc.ENUM_LMAValidateContext.LMAValidateOpen

bOpened = True
sFileName = "Drawing Opened " 'Title information for Drawing Event (Open) log file



'Drawing Close
Case LMForeignCalc.ENUM_LMAValidateContext.LMAValidateClose


sFileName = "Drawing Closed " 'Title information for Drawing Event (Close) log file


'Begin AutoGap on active drawing
Dim auto As New AutoGapAll.AutoGapAllCmd
auto.GapAll datasource.PIDMgr.Application.RADApplication
'End AutoGap on active drawing


'Drawing Create
Case LMForeignCalc.ENUM_LMAValidateContext.LMAValidateCreate


sFileName = "Drawing Created " 'Title information for Drawing Event (Created) log file


'Drawing Delete
Case LMForeignCalc.ENUM_LMAValidateContext.LMAValidateDelete


sFileName = "Drawing Deleted " 'Title information for Drawing Event (Deleted) log file


'Drawing Modify
Case LMForeignCalc.ENUM_LMAValidateContext.LMAValidateModify


sFileName = "Drawing Modified " 'Title information for Drawing Event (Modified) log file


End Select


'Create file
If Len(sFileName) > 0 Then CreateFile sFileName, Items 'Uses Title information from above Drawing Event (Case) that was accessed.

ILMForeignCalc_DoValidateItem = True



If bOpened = True Then

Dim NewText As Boolean
NewText = True

Set Dialog = New UpdateWPNoteDialog


Dialog.Show vbModal

'Dialog.Hide

If Dialog.isOK Then
NewText = True
End If

Unload Dialog
Set Dialog = Nothing

End If


If NewText = True Then

Dim objDrawing As LMDrawing
Set objDrawing = datasource.GetDrawing(datasource.PIDMgr.Drawing.Id)

'MsgBox "Drawing id is " & objDrawing

'Filter retriving Item Note from active drawing
Dim objFilterItemNote As LMAFilter
Set objFilterItemNote = New LMAFilter

objFilterItemNote.Criteria.AddNew ("FirstOne")
objFilterItemNote.Criteria.Item("FirstOne").SourceAttributeName = "Representation.Drawing.Name"
objFilterItemNote.Criteria.Item("FirstOne").ValueAttribute = objDrawing.Attributes("Name").Value
objFilterItemNote.Criteria.Item("FirstOne").Operator = "="
'objFilterPRun.ItemType = "PlantItem"
objFilterItemNote.ItemType = "ItemNote"

objFilterItemNote.Criteria.AddNew ("SecondOne")
objFilterItemNote.Criteria.Item("SecondOne").SourceAttributeName = "ItemStatus"
objFilterItemNote.Criteria.Item("SecondOne").ValueAttribute = 1
objFilterItemNote.Criteria.Item("SecondOne").Operator = "="
objFilterItemNote.Criteria.Item("SecondOne").Conjunctive = True

Dim itemnote As LMItemNote
Dim itemnotes As LMItemNotes
Set itemnotes = New LMItemNotes
itemnotes.Collect datasource, Filter:=objFilterItemNote

Dim WPNoteNumber As String
Dim RowIndex As Integer

For Each itemnote In itemnotes
If itemnote.Attributes("Note.NoteType").Value = "Remark" Then
If Not IsNull(itemnote.Attributes("Note.WPNoteNumber").Value) Then
WPNoteNumber = itemnote.Attributes("Note.WPNoteNumber").Value
If LookUpWPNumber(WPNoteNumber, RowIndex) Then
If LookUpWPNoteText(WPNoteNumber) <> itemnote.Attributes("Note.WPNoteText").Value Then
itemnote.Attributes("Note.WPNoteText").Value = LookUpWPNoteText(WPNoteNumber)
itemnote.Commit
End If
End If
End If
End If
Next

'******** Commented out the MsgBox because it is not needed. 1/5/2011

'MsgBox "Updating Item Note is done!!"

Set objDrawing = Nothing
Set objFilterItemNote = Nothing
Set itemnote = Nothing
Set itemnotes = Nothing

End If

Exit Function

ErrHndl:

MsgBox Err.Description
ILMForeignCalc_DoValidateItem = False

End Function

'Create file for the Context Type (Create, Delete, Open, Close, Modify, or Print) in the "Environ("Temp")" Directory and log drawing info.
'Create the "Environ("Temp")" Directory if doesn't already exist.

Private Sub CreateFile(sFileName As String, Optional Items As Llama.LMAItems)

Dim lFileNum As Long
Dim fso As New FileSystemObject
Dim sFolder As String

' sFolder = "c:\Temp"
sFolder = Environ("Temp")

On Error GoTo ErrHndl

'Create folder if doesn't exist
If Not fso.FolderExists(sFolder) Then
fso.CreateFolder sFolder
End If

'Add date and time to file name
sFileName = sFolder & "\" & sFileName & Replace(DateTime.Time$, ":", "") & ".txt"

lFileNum = FreeFile
Open sFileName For Output As #lFileNum

If Not Items Is Nothing Then
Write #lFileNum, "Item Type: " & Items.Nth(1).ItemType
Write #lFileNum, "SPID: " & Items.Nth(1).Id
Write #lFileNum, "Name: " & Items.Nth(1).Attributes("Name")
Else
Write #lFileNum, "Items don't exists (Connection missing)"
End If

Close #lFileNum
Set fso = Nothing
Exit Sub

ErrHndl:

Err.Raise Err.Number, "Validate.CreateFile", Err.Description

End Sub

Private Function ILMForeignCalc_DoValidateProperty(datasource As Llama.LMADataSource, Items As Llama.LMAItems, PropertyName As String, Value As Variant) As Boolean

End Function

Private Sub ILMForeignCalc_DoValidatePropertyNoUI(datasource As Llama.LMADataSource, Items As Llama.LMAItems, PropertyName As String, Value As Variant)

End Sub

'Create a new file each time a print event is fired

Private Function IPrintValidation_DoValidatePrint(ByVal DrawingSPID As String, ByVal DrawingName As String, datasource As Llama.LMADataSource, Items As Llama.LMAItems) As Boolean

On Error GoTo ErrHndl

If IPrintValidation_UseDataSourceOnPrint Then

CreateFile "Drawing Printed with DB ", Items

Else

CreateFile "Drawing Printed "

End If

IPrintValidation_DoValidatePrint = True

Exit Function

ErrHndl:

IPrintValidation_DoValidatePrint = False

End Function

Private Property Get IPrintValidation_UseDataSourceOnPrint() As Boolean

IPrintValidation_UseDataSourceOnPrint = True

End Property
Private Function LookUpWPNoteText(WPNoteNumber As String) As String

Dim objExcel As Excel.Application
Dim strFileName As String

Dim SourceNumber As String
Dim SourceText As String

Dim Row As Integer
Dim RowMax As Integer
Row = 1
RowMax = Row + 1

Dim NumberRow As Integer
Dim NumberRowMax As Integer
NumberRow = 1

Dim RowIndex As Integer
RowIndex = 1

Set objExcel = CreateObject("excel.Application")

'objExcel.Workbooks.Open (Environ("TEMP") & "\WPNoteText.xls") ' substitute your file here
'objExcel.Workbooks.Open ("\\ushouwpcad02\TrainingProject2009\Documents\notes.xls") ' substitute your file here
'**added LKB to set file path for active project
Dim datasource As LMADataSource
Dim ProjectName As String
Dim blnUsePIDDatasource As Boolean
If Not blnUsePIDDatasource Then
Set datasource = New LMADataSource
'Else
' Set datasource = PIDDataSource
End If
ProjectName = datasource.ProjectNumber

If ProjectName = "StdBldWP09" Then
objExcel.Workbooks.Open ("\\ushouwpcad02\StdBldWP2009\Document\PIDNotes\StdbldWP09PIDNotes.xls")
ElseIf ProjectName = "Shtokman" Then
objExcel.Workbooks.Open ("L:\156700-SFPSO\05\PR\Process\PID Notes\ShtokmanPIDNotes.xls")
ElseIf ProjectName = "Hebron" Then
objExcel.Workbooks.Open ("\\ushouwpcad02\Hebron\Document\PIDNotes\HebronPIDNotes.xls")
ElseIf ProjectName = "USSWOTST1" Then
objExcel.Workbooks.Open ("\\ushouwpcad02\USSWOTST1\Document\Notes\USSWOTST1notes.xls")
ElseIf ProjectName = "USSWOSTD" Then
objExcel.Workbooks.Open ("\\ushouwpcad02\USSWOSTD\Document\Notes\USSWOSTDNotes.xls")
End If
Set datasource = Nothing
'** LKB
objExcel.Visible = False

Do While Row < RowMax
SourceNumber = objExcel.Worksheets("Sheet1").Cells(Row, 1).Value
If SourceNumber = "" Then
RowMax = Row
Else
Row = Row + 1
RowMax = Row + 1
End If
Loop

Row = 1
SourceNumber = ""
SourceText = ""

Do While NumberRow < RowMax
'SourceNumber = objExcel.Worksheets("Sheet1").Cells(NumberRow, 1).value
'SourceText = objExcel.Worksheets("Sheet1").Cells(NumberRow, 2).value

If LookUpWPNumber(WPNoteNumber, RowIndex) Then
SourceText = objExcel.Worksheets("Sheet1").Cells(RowIndex, 2).Value
LookUpWPNoteText = SourceText
RowMax = NumberRow
Else
NumberRow = NumberRow + 1
'MsgBox "Cannot find the matched source note. Do you want to key in the Note Text?"
End If
Loop


objExcel.Application.Quit
Set objExcel = Nothing

End Function
Private Function LookUpWPNumber(WPNoteNumber As String, RowIndex As Integer) As Boolean


LookUpWPNumber = False

Dim objExcel As Excel.Application
Dim strFileName As String

Dim NotFound As Boolean
NotFound = True

Dim Row As Integer
Dim RowMax As Integer
Row = 1
RowMax = Row + 1

Dim RowNumber As Integer
Dim RowMaxNumber As Integer
RowNumber = 1


Dim SourceNumber As String
'Dim SourceText As String

Set objExcel = CreateObject("excel.Application")

'objExcel.Workbooks.Open (Environ("TEMP") & "\WPNoteText.xls") ' Substitute your path or file here
'objExcel.Workbooks.Open ("\\ushouwpcad02\TrainingProject2009\Documents\notes.xls") ' substitute your file here
'**added LKB to set file path for active project
Dim datasource As LMADataSource
Dim ProjectName As String
Dim blnUsePIDDatasource As Boolean
If Not blnUsePIDDatasource Then
Set datasource = New LMADataSource
'Else
' Set datasource = PIDDataSource
End If
ProjectName = datasource.ProjectNumber

If ProjectName = "StdBldWP09" Then
objExcel.Workbooks.Open ("\\ushouwpcad02\StdBldWP2009\Document\PIDNotes\StdbldWP09PIDNotes.xls")
ElseIf ProjectName = "Shtokman" Then
objExcel.Workbooks.Open ("L:\156700-SFPSO\05\PR\Process\PID Notes\ShtokmanPIDNotes.xls")
ElseIf ProjectName = "Hebron" Then
objExcel.Workbooks.Open ("\\ushouwpcad02\Hebron\Document\PIDNotes\HebronPIDNotes.xls")
ElseIf ProjectName = "USSWOTST1" Then
objExcel.Workbooks.Open ("\\ushouwpcad02\USSWOTST1\Document\Notes\USSWOTST1notes.xls")
ElseIf ProjectName = "USSWOSTD" Then
objExcel.Workbooks.Open ("\\ushouwpcad02\USSWOSTD\Document\Notes\USSWOSTDNotes.xls")
End If
Set datasource = Nothing
'** LKB
objExcel.Visible = False

Do While Row < RowMax
SourceNumber = objExcel.Worksheets("Sheet1").Cells(Row, 1).Value
If SourceNumber = "" Then
RowMax = Row
Else
Row = Row + 1
RowMax = Row + 1
End If
Loop


SourceNumber = ""

Do While RowNumber < RowMax
SourceNumber = objExcel.Worksheets("Sheet1").Cells(RowNumber, 1).Value

If SourceNumber <> WPNoteNumber Then
RowNumber = RowNumber + 1
Else
NotFound = False
RowIndex = RowNumber
RowMax = RowNumber
'MsgBox "Cannot find the matched source note. Please key in the Note Text!"
End If
Loop

If NotFound = False Then
LookUpWPNumber = True
Else
LookUpWPNumber = False
MsgBox "Cannot find the matched source Note Number!"
End If


'ActiveWorkbook.Save

objExcel.Application.Quit
Set objExcel = Nothing

End Function

Recommended Answers

All 2 Replies

This is the code from the form reference in the earlier code.

the from is UPDATEWPNOTEDIALOG

Option Explicit
Public isOK As Boolean
Private Sub CancelButton_Click()
    isOK = False
    Me.Hide
End Sub

Private Sub OKButton_Click()
    isOK = True
    Me.Hide
End Sub
Private Sub Form_Load()

    'set font
    Call GetStockFont(Me)
    
    isOK = False

    
End Sub

If you are using Vista or Win7, Sendkeys will throw an error. Try the following which is working fine in all OS versions -

'Set a reference to MS Scripting runtime...
'Under your text box keypress event...
Dim WshShell As Object

Set WshShell = CreateObject("WScript.Shell")

If Not IsNumeric(txtIdNumber.Text) Then
    WshShell.SendKeys "{BackSpace}"
End If 'To validate a number OR...
WshShell.SendKeys "{Return}" 'Or enter if return is incorrect
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.