Showing posts with label VB 6.0. Show all posts
Showing posts with label VB 6.0. Show all posts

Saturday, June 4, 2016

Solution for Sendkey Permission Denied For Vb.6.0

//Sendkey Permission Denied For Vb.6.0

Public Sub sendkeys_New (text As Variant, Optional wait As Boolean = False)
Dim WshShell As Object
Set WshShell = CreateObject('wscript.shell')
WshShell.Sendkeys CStr(text), wait
Set WshShell = Nothing
End Sub



Example :

sendkeys_New  '{TAB}'

Friday, June 3, 2016

Find Form Name In VB6.0 File ( *.VBP) File

‘ Take 3 List Box in Your Form and  1 command Button




Private Sub Command1_Click()
‘ Enter Your Project FileName
TransferProjectDetails (“TEST.vbp”)
End Sub


Public Function TransferProjectDetails(ProjectVbpFile As String) As Boolean
Dim ln As Integer ‘ for lineno
Dim opos As Integer ‘for opening position
‘On Error GoTo errlbl
TransferProjectDetails = False
Dim TextLine
If Len(ProjectVbpFile) = 0 Then
    ProjectVbpFile = “\project1.vbp”
Else
    ProjectVbpFile = “\” & ProjectVbpFile
End If
Open App.Path & ProjectVbpFile For Input As #1 ‘ Open file.
Open App.Path & “\ProjectFileDetails.txt” For Output As #2 ‘ Open file.
Do While Not EOF(1) ‘ Loop until end of file.
ln = ln + 1
Line Input #1, TextLine ‘ Read line into variable.
Debug.Print ln & ” ” & TextLine ‘ Print to the Immediate window.


If InStr(1, TextLine, “Sub”) > 0 Then
    opos = ln
    Print #2, ln & ” ” & TextLine ‘TextLine
ElseIf InStr(1, TextLine, “Form=”) = 1 Then
    ” = 1 means it gets only forms filenames. not name of the forms name property
    Print #2, ln & ” ” & TextLine
    fname = Right(TextLine, Len(TextLine) – (InStr(TextLine, “=”)))
    List1.AddItem fname
ElseIf InStr(1, TextLine, “Module=”) = 1 Then
    Print #2, ln & ” ” & TextLine
    Mfname = Right(TextLine, Len(TextLine) – (InStr(TextLine, “;”)))
    List2.AddItem Mfname
    ‘print #2,
ElseIf InStr(1, TextLine, “Class=”) > 0 Then
    Print #2, ln & ” ” & TextLine
    Cfname = Right(TextLine, Len(TextLine) – (InStr(TextLine, “;”)))
    List3.AddItem Trim(Cfname)
    ‘print #2,
End If
Loop
Close #1 ‘ Close file.
Close #2
TransferProjectDetails = True
Exit Function
errlbl:
MsgBox Err.Description
TransferProjectDetails = False


End Function

Remove VbCrlf Value In String From Starting Or End

Private Function RemoveVbCrlf(StrText As String) As String
    If Right$(StrText, 2) = vbCrLf Then
        RemoveVbCrlf = Left$(StrText, Len(StrText) – 2)
        StrText = Left$(StrText, Len(StrText) – 2)
    End If
   
    If Left$(StrText, 2) = vbCrLf Then
        RemoveVbCrlf = Right$(StrText, Len(StrText) – 2)
    End If
   
    If Len(RemoveVbCrlf) = 0 Then
        RemoveVbCrlf = StrText
    End If
End Function

Clear TextBox In Vb 6.0 less Code

//All Clear Teaxbox in vb6.0 less Code
Public Sub ClearText(ByRef SRC_FORM As Form)

On Error Resume Next

Dim Control As Control

For Each Control In SRC_FORM.Controls

If (TypeOf Control Is TextBox) Then Control = vbNullString

Next Control

Set Control = Nothing

End Sub

(-)Round Function in Vb 6.00

//(-)Round Function in Vb 6.00
If You Want To Round in last 2 digit Exm. 151 = 200        And  149 = 100 Round1(Value,-2)

Private Function Round1(DouAmt As Double, IntDegit As Integer) As Double

IntDegit = Abs(IntDegit)

DouAmt = Round(DouAmt)

If IntDegit = 0 Then

Round1 = DouAmt

Exit Function

End If



If Right(DouAmt, IntDegit) < Val('5' + String(IntDegit - 1, '0')) Then

Round1 = (DouAmt - Right(DouAmt, IntDegit))

Else

Round1 = (DouAmt - Right(DouAmt, IntDegit)) + Val('10' + String(IntDegit - 1, '0'))

End If

End Function
End Function