Tracking Forums, Newsgroups, Maling Lists
Home Scripts Tutorials Tracker Forums
 
  HOME    TRACKER    Visual Basic




Whats Wrong With This Floodfill And Dc Buffer Code?


all i can see is the grey background that the form starts with. I cant see why i cant make the background blue by:
1.flood filling to the buffer dc
2. biblting bufferdc to form1

heres the code below, and the program is attached.


Code:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Const IMAGE_BITMAP As Long = &O0
Const LR_LOADFROMFILE As Long = 16
Const PLAYER_NUMBER As Integer = 20
Dim CircleDC As Long
Dim CircleBMP As Long
Dim BufferDC As Long
Dim BufferBMP As Long
Dim MyBrush As Long

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then End
End Sub

Private Sub Form_Load()
Me.Show
Me.Height = PLAYER_NUMBER * 12 * 15
Me.Width = Me.Height * 2
Me.ScaleMode = 3
Me.BorderStyle = 1


CircleDC = CreateCompatibleDC(0)
CircleBMP = LoadImage(0, App.Path & "circles.BMP", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
DeleteObject SelectObject(CircleDC, CircleBMP)
DeleteObject CircleBMP

BufferDC = CreateCompatibleDC(Form1.hdc)
BufferBMP = CreateCompatibleBitmap(BufferDC, Me.ScaleWidth, Me.ScaleHeight)
DeleteObject SelectObject(BufferDC, BufferBMP)
DeleteObject BufferBMP

MyBrush = CreateSolidBrush(vbWhite)
SelectObject BufferDC, MyBrush
FloodFill BufferDC, 1, 1, 1
DeleteObject MyBrush

BitBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, BufferDC, 0, 0, vbSrcCopy
End Sub

Private Sub Form_Unload(Cancel As Integer)
DeleteDC CircleDC
DeleteDC BufferDC
End Sub




View Complete Forum Thread with Replies

See Related Forum Messages: Follow the Links Below to View Complete Thread
Using Floodfill, Whats Wrong With This Code?
im trying to floodfill a picture box with a certain colour, ive used the floodfill command before and had it working. But for some reason i just cant get it working now. Heres my code can you please tell me what the problem is thx.



Quote:




Private Sub Command2_Click()
FloodFill Picture1.hdc, 1, 1, vbRed
End Sub

Help With Code!! Whats Wrong With This Code, Command5 Does Not Work.
this command does not work i have no idea could i get some help!!

Code:
Private Sub Command5_Click()
Dim score1 As Integer
Dim score2 As Integer
score1 = Label12.Caption
score2 = Label13.Caption
Dim bet As Integer
Dim money1 As Integer
Dim money2 As Integer
bet = Label14.Caption
money1 = Label10.Caption
money2 = Label11.Caption
If score1 > score2 Then
money2 = money2 - bet
money1 = money1 + bet
End If
If score2 > score1 Then
money1 = money1 - bet
money2 = bet + money2
End If
End Sub
if you need the whole code here it is......

Code:
Private Sub Command1_Click()
Timer1.Enabled = True
Label3.Caption = " "
End Sub

Private Sub Command2_Click()
Dim goodroll2 As Integer
Dim goodroll As Integer
Dim goodrolladd As Integer
goodroll = Label1.Caption
goodroll2 = Label2.Caption
goodrolladd = goodroll + goodroll2
If goodrolladd > 7 Then Label3.Caption = "Good Roll!!!"
Timer1.Enabled = False
If Label1.Caption = 1 And Label2.Caption = 1 Then Label3.Caption = "snake eyes!!"
If Label1.Caption = 1 And Label2.Caption = 1 Then Timer2.Enabled = True
Label12.Caption = goodrolladd
End Sub

Private Sub Command3_Click()
Timer3.Enabled = True
Label3.Caption = " "
End Sub

Private Sub Command4_Click()
Dim goodrolltwo As Integer
Dim goodrolltwox2 As Integer
Dim goodrolladdtwo As Integer
goodrolltwo = Label8.Caption
goodrolltwox2 = Label9.Caption
goodrolladdtwo = goodrolltwo + goodrolltwox2
If goodrolladdtwo > 7 Then Label3.Caption = "Good Roll!!!"
Timer3.Enabled = False
If Label8.Caption = 1 And Label9.Caption = 1 Then Label3.Caption = "snake eyes!!"
If Label8.Caption = 1 And Label9.Caption = 1 Then Timer2.Enabled = True
Label13.Caption = goodrolladdtwo

End Sub

Private Sub Command5_Click()
Dim score1 As Integer
Dim score2 As Integer
score1 = Label12.Caption
score2 = Label13.Caption
Dim bet As Integer
Dim money1 As Integer
Dim money2 As Integer
bet = Label14.Caption
money1 = Label10.Caption
money2 = Label11.Caption
If score1 > score2 Then
money2 = money2 - bet
money1 = money1 + bet
End If
If score2 > score1 Then
money1 = money1 - bet
money2 = bet + money2
End If

End Sub

Private Sub Command6_Click()
Label14.Caption = Text3.Text
Text3.Text = " "
End Sub

Private Sub Form_Load()
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
End Sub




Private Sub Timer1_Timer()
Label1.Caption = Int((0 - 7 + 1) * Rnd + 7)
Label2.Caption = Int((0 - 7 + 1) * Rnd + 7)
End Sub

Private Sub Timer2_Timer()
Label3.ForeColor = Int((&HFFFFFF - &H400040 + 1) * Rnd + &H400040)
End Sub

Private Sub Timer3_Timer()
Label8.Caption = Int((0 - 7 + 1) * Rnd + 7)
Label9.Caption = Int((0 - 7 + 1) * Rnd + 7)
End Sub

Whats Wrong With This Code?
I had this working fine about an hour ago untill I started messing with field restrictions to protect the fields from returning nothing. And now Ive messed up my code good it seems...

Help >_<;


Code:
'Connecting to the server
Private Sub cmdConnect_Click()
tcpClient.RemoteHost = txtIP.Text
tcpClient.RemotePort = 1001
tcpClient.Connect
End Sub

'Sends a connection msg to the server
Private Sub cmdEnter_Click()
tcpClient.SendData txtName.Text (" Connected")
Unload Me
End Sub
txtIP is the IP entering field
txtName is a field for ther persons name

Whats Wrong With This Code?
Hi,

I am using XP, this code use to work on my old system (WIN98) but will not work on my XP:
Code:
Dim objOutlook, objMsg, objNameSpace, objFolder, strOutput, strSubject, StrTo, StrMsg, Strcc, strSB
Const olMailItem = 0
Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objMsg = objOutlook.CreateItem(olMailItem)
objMsg.To = StrTo
objMsg.CC = Strcc
objMsg.Display
objMsg.Subject = "test"
objMsg.Body = "test"
Set objFolder = Nothing
Set objNameSpace = Nothing
Set objOutlook = Nothing
Set objMsg = Nothing
Set ss = CreateObject("WScript.Shell")
Set ss = Nothing
The error I am getting is as follows:

Run-time error-'2147287037 (80030003)

The operation failed.

When Debug it highlights the following line:

Set objMsg = objOutlook.CreateItem(olMailItem)

..... many help for your assistance.

Rgds,
Daniel.

Whats Wrong With This Code?
Hey,

Ive got a problem with a directX dodgeball game i'm making, I told my program to play an animation on the key down event and move forward but after a second of holding down the key, the animation stops moving, heres the code.


Code:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyUp Then

prevY = cdsSprite(0).Y
prevX = cdsSprite(0).X

Set cdsSprite(0) = New clsDDSprite7
With cdsSprite(0)

.Create ddraw

.LoadFromFile App.Path & "artworkplayers" & Team & "forward.bmp", 50, 50, 4, 8

.Y = prevY
.X = prevX

.SpeedY = -5
End With

End If

End Sub
I think i need to use directinput, but if theres any other solution to this problem that doesnt involve directinuput, please tell me

Whats Wrong With This Code?
I am getting an error in the fisrt line of this code. I am searching for a 1 in that range. If there is one, I want it to copy the row to the report page? Is this right?

If Sheets("Model").Range("D2:D13").Value = 1 Then
Sheets("Report").Range("A2").copy
End If

Whats Wrong With This Code.
Simple bit of code that states if the data in the cell is an error (#N/A) delete the whole row.

It's not working

Do

If ActiveCell.FormulaR1C1 = "=ISNA()= " Then

Selection.EntireRow.Delete

Else


ActiveCell.Offset(0, -5).Range("A1:E1").Copy Destination:=ActiveCell.Range("b1")


End If

ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -1))



End Sub

Whats Wrong With This Code?
Hi All

Please can someone tell me what i am doing wrong here, I have a flexgrid on a form that is unbound to an access db, the grid is populated with data from a command button. So what i am trying to do is when the user clicks on some text in the flexgrid "grdJournal" two text boxes are populated with the row data and i have written the following search sting to find the corresponding data in the db and a message box pops up "Match found" i then need to rename the item in that field to "VOID" everything works fine except that the item does not get renamed and i can't seem to figure out why.


Code:
Private Sub grdJournal_Click()
Dim MyConn As ADODB.Connection
Dim MyRecSet As ADODB.Recordset
Dim sSQL As String
Dim strDescription As String
Dim strTableNo As String
strDescription = txtDescription.Text
strTableNo = lblTabNo.Caption
Set MyConn = New ADODB.Connection
Set MyRecSet = New ADODB.Recordset
MyConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:pospos.mdb;"
MyConn.Open
sSQL = " SELECT * FROM Sales1 "
MyRecSet.Open sSQL, MyConn, adOpenStatic, adLockOptimistic
MyRecSet.MoveFirst
Do While Not MyRecSet.EOF
If MyRecSet.Fields("Description").Value = strDescription And MyRecSet.Fields("Tbl_No").Value = strTableNo Then
MsgBox "Match Found"
MyRecSet.Fields("Description").Value = "Void"
Exit Do
End If
MyRecSet.MoveNext
Loop

End Sub
Many thanks in advance

Whats Wrong With This Code?
Hi

I am still on the topic of my previouse thread, but i decided to code the connection rather and use a VsFlexgrid instead of datagrid. So now the grid is populated from code but when i enter a name in the textBox txtSearch i get a "Not allowed when object is open" error please can someone advise me.


Code:
Dim MyConn As ADODB.Connection
Dim MyRecSet As ADODB.Recordset
Dim sSQL As String
Private Sub Form_Load()
Set MyConn = New ADODB.Connection
Set MyRecSet = New ADODB.Recordset
MyConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:pospos.mdb;"
MyConn.Open
sSQL = "SELECT * FROM Customers"

MyRecSet.Open sSQL, MyConn, adOpenStatic, adLockReadOnly

Set fg.DataSource = MyRecSet
End Sub
Private Sub txtSearch_Change()
If MyRecSetState = adStateOpen Then MyRecSet.Close
MyRecSet.Open "Select Customer_Name FROM Customers WHERE Customer_Name Like '" & txtSearch.Text & "'"
Set fg.DataSource = MyRecSet
End Sub
Many thanks

Whats Wrong With This Code
Hi

Please scan someone help me fix this code, i have a field in an access database called "Covers" it is a number field and i am trying to get the sum of covers for the current date, but the code below only counts the records.

Dim MyConn As ADODB.Connection
Dim MyRecSet As ADODB.Recordset
Dim sSQL As String
Set MyConn = New ADODB.Connection
Set MyRecSet = New ADODB.Recordset
MyConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:quick-resdatadata.mdb;"
MyConn.Open
sSQL = "SELECT SUM(Covers) FROM Guests Where [Arrival Date] = #" & Format(Date, "d/m/yyyy") & "#"

MyRecSet.Open sSQL, MyConn, adOpenStatic, adLockReadOnly

txtCovers.Text = MyRecSet.Fields("Covers")

Please can someone advise me.

Many thanks.

Whats Wrong With This Code
Hi

Please can someone tell me what is wrong with this code, i figured out how to get a picture into cells and merge them, with a friends help, but the code below puts the picture in one place only, i can see why its doing that but cant figure out how to change it. Basically i need the picture to appear in the cells that i have selected. Please help

Private Sub fg_Click()
fg.MergeCells = flexMergeFree
fg.MergeRow(3) = True
fg.MergeRow(4) = True
fg.TextMatrix(3, 3) = "Heading One"
fg.TextMatrix(3, 4) = "Heading One"
fg.Row = 3
fg.Col = 3
fg.CellPicture = LoadPicture("C:logo.bmp")
end Sub

Many thanks in advance

Whats Wrong With This Code?
Hi all, im very new to VB and this is the 1st thing im doing in collage.

I have to write a code using these two loops we have been laught, the loop untill and while loop. We have to create a code that will take 10 numbers entered and find the average of the 10 numbers, the numbers entered must be between 0 and 100.

I was thinking

loop 0 to 9
while number >0, <100 do
input number
total=total+number/(loop+1)
end while
next loop

please help as this is the 1st time ive ever done programming

Whats Wrong With My Code??
I am trying to read through the first column of my activeworksheet find a name take the value next to it and throw it in another cell. Here's the code.

Sub find_name()
ActiveSheet.Unprotect
Dim r As Range
Dim miketot As Currency
Set r = ActiveSheet.Cells.Columns(1).Find("mike")
If Not (r Is Nothing) Then
miketot = r.Offset(0, 1).Value
Else
MsgBox "Not found"
End If
MsgBox miketot
Range("j4").Select
ActiveCell.FormulaR1C1 = miketot

End Sub


It is assigning r.offset(0,1).value correctly. My msgbox miketot is giving the proper value, but I get an error 400 after this msgbox is displayed

Whats Wrong With This Code?
Hey. I'm really new to VB, and I'm trying to write my own Fantasy Football Stat Tracker. I figured that I could have the program go to NFL.com and click on the game updates and gather the information. I wasn't sure if it could click on links so I asked people yesterday. I did a search in VB for URLDownloadToFile (Yesterday somebody told me that I could use that to download the information on a webpage to a text file) but this code doesn't work. Can anybody help me out?

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

' Note that this file is 2M, so you might want to try with something simpler
Dim errcode As Long
Dim url As String
Dim localFileName As String

url = "http://www.vb2themax.com/vbmaximizer/files/vbm_demo.zip"
localFileName = "c:vbm_demo.zip"

errcode = URLDownloadToFile(0, url, localFileName, 0, 0)
If errcode = 0 Then
MsgBox("Download ok")
Else
MsgBox("Error while downloading")
End If

Thanks.

Ok, Whats Wrong With This Code?
I have a chat program and there has been a problem with people signing in with the same names. I want to fix that. I put this code in the sock_DataArrival sub.

Code:
Select Case msg(0)
Case "name"
For i = 0 To List.ListCount - 1
If lcase(list.list(i)) = lcase(msg(1)) Then
sock(index).senddata "systemmessage" & "|" & "This username is already taken!"
doevents
sock(index).close
Else
sock(Index).Tag = msg(1)
SetList
SendConnects
End If
Next i
I went to test it and I keep getting an error. How would I be able to make it where I can put a list of user names that people can't use. For example, the server is the server admin. The name of the server is Server Admin. I want to make it where people can't use that name to log in and chat.

Any help will be greatly appreciated.

Whats Wrong With Using &gt;&gt; In My Code,
Hi... can anyone tell me whats wrong with my code... and why i can;t use >>

Private Sub Cal_Quit_Click()

Dim crc_res As Byte
Dim snr_8 As Byte

Let snr_8 = 0
For snr_8 = 0 To 256

crc_res = crc8fun(snr_8, quit_preset)
txtDataOut.Print crc_res


End Sub


Function crc_8fun%(crc8_input As Byte, preset As Byte)

Dim loop1 As Integer

Dim Out As Byte
Dim loop1 As Integer
Dim crc_pol As Byte

Let crc_pol = &HB8

Out = crc8_input ^ preset

Let loop1 = 0

For loop1 = 0 To 8

If (Out And &H1) Then /////Anything wrong with this statement. In C++ i use that, not sure VB can or not??
Out = (Out>>1)^crc_pol
Else
Out = (Out>>1)

crc8 = Out
End Function

Whats Wrong With This Code
Code:
Private Sub cmdStart_Click()

If fDate = "Sunday" Then
If cboMonth.Text = january Then
Text3(0).Text = "1"
Text3(1).Text = "2"
Text3(2).Text = "3"
Text3(3).Text = "4"
Text3(4).Text = "5"
Text3(5).Text = "6"
Text3(6).Text = "7"
Text3(7).Text = "8"
Text3(8).Text = "9"
Text3(9).Text = "10"
Text3(10).Text = "11"
Text3(11).Text = "12"
Text3(12).Text = "13"
Text3(13).Text = "14"
Text3(14).Text = "15"
Text3(15).Text = "16"
Text3(16).Text = "17"
Text3(17).Text = "18"
Text3(18).Text = "19"
Text3(19).Text = "20"
Text3(20).Text = "21"
Text3(21).Text = "22"
Text3(22).Text = "23"
Text3(23).Text = "24"
Text3(24).Text = "25"
Text3(25).Text = "26"
Text3(26).Text = "27"
Text3(27).Text = "28"
Text3(28).Text = "29"
Text3(29).Text = "30"
Text3(30).Text = "31"
End If
End If

End Sub
Please help me with this I have wit a road block with this one. and is there any way I could do a loop to simplify this?

Thank you
kulbak

Vb Code !!!! Whats Wrong ??
please take a look at this , its to put a "stop" on network traffic..

doesnt seam to work on vb6 , not sure what it was created for ?

falls down at "Public Declare Function RasEnumConnections Lib "rasapi32.dll" ()
Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long,
lngConnections As Long) As Long"

&

"Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" ()
(ByVal hRasConn As Long) As Long"

Whats Wrong With This Code?
Ok, i've handled the .res file, now i need the extraction code..what is wrong with the code below??it says Error 424, Object Required then it highlights the line that says:
SavePicture myVar, "c:itmap1.bmp"

What is up with that??

Dim myVar As Variant
myVar = LoadResPicture("BITMAP1", vbResBitmap)
SavePicture myVar, "c:itmap1.bmp"

Whats Wrong With My Code?
this code is suppose to find errors and if none are found display names i a listbox from a txt File

Private Sub cmdOpen_Click()
Dim Record As Display
Dim FileNumber As Integer

FileNumber = FreeFile

lstName.Clear
On Error GoTo fileError
Open txtFile.Text For Input As #FileNumber
Do While Not EOF(FileNumber)
Input #1, Record.FName, Record.LName, Record.Phone, Record.DOB
lstName.AddItem Record.FName
Loop
Close #FileNumber
Exit Sub

fileError:
Select Case Err.Number
Case 53
MsgBox "txtFile.txt" & " " & Err.Description, vbOKOnly, "Error"
Case 75
MsgBox "txtFile.txt" & " " & Err.Description, vbOKOnly, "Error"
Case Else
MsgBox Err & "." & Err.Description, vbOKOnly, "Error"
End Select
End Sub

Any suggestions??
Thanx guys!

"Shibby!"

Whats Wrong With This Code
Hi

Could someone please advise me on what is wrong or missing from this code,
What I have is a textbox to select a “Suite” number and two DTPickers, one for a start date and one for an end date, I am using crystal reports 8 connected to an access database.
This code works in these two instances, if I select say Suite2 with no dates, then every Suite 2 in my database gets displayed in the report which is great. If I select a start date and an end date then it brings up all the Suites under those dates, this too is great. BUT
If I select “Suite2” and dates from lets say 01/10/2005 to 30/10/2005, then it brings up all the Suites that fall under those dates, when in fact all i want to see on the report is only “Suite2” from the dates selected. Please help.


Private Sub Command1_Click()


Dim lSql As String

If Trim(Text1.Text) <> "" Then
lSql = " SELECT Rooms.[Customer name], Rooms.[Contact details], Rooms.Suite, " & _
" Rooms.[Arrival date], Rooms.[Departure Date], Rooms.[Credit Card], Rooms.Expires, " & _
" Rooms.Pan, Rooms.Cheque, Rooms.Cash, Rooms.Requests " & _
" From Rooms " & _
" WHERE Rooms.Suite = '" & CStr(Text1.Text) & "' "
End If


lSql = " SELECT Rooms.[Customer name], Rooms.[Contact details], Rooms.Suite, " & _
" Rooms.[Arrival date], Rooms.[Departure Date], Rooms.[Credit Card], Rooms.Expires, " & _
" Rooms.Pan, Rooms.Cheque, Rooms.Cash, Rooms.Requests " & _
" From Rooms " & _
" WHERE Rooms.[Arrival date] between '" & CStr(DTPicker1.Value) & "' and '" & CStr(DTPicker2.Value) & "' "

With rptMain

.ReportFileName = App.Path + " 3.rpt"
.SQLQuery = lSql
.Destination = crptToWindow

.PrintReport

End With

If rptMain.PrintReport <> 0 Then
MsgBox rptMain.LastErrorString
Screen.MousePointer = vbDefault
End If

End Sub



rptMain is the name of my crystal reports OCX

Kind Regards

Whats Wrong With This Code?!
Private Sub Command1_Click()

housearray(1).house = "Arana"
housearray(2).house = "Bukari"
housearray(3).house = "Camira"
housearray(4).house = "Duwari"
housearray(1).score = "5"
housearray(2).score = "10"
housearray(3).score = "5"
housearray(4).score = "20"

Do Until n = 5
If housearray(1).score < housearray(2).score Then
temp1 = housearray(1).score
housearray(1).score = housearray(2).score
housearray(2).score = temp1

temp2 = housearray(1).house
housearray(1).house = housearray(2).house
housearray(2).house = temp2
End If

If housearray(2).score < housearray(3).score Then
temp1 = housearray(2).score
housearray(2).score = housearray(3).score
housearray(3).score = temp1

temp2 = housearray(2).house
housearray(2).house = housearray(3).house
housearray(3).house = temp2
End If

If housearray(3).score < housearray(4).score Then
temp1 = housearray(3).score
housearray(3).score = housearray(4).score
housearray(4).score = temp1

temp2 = housearray(3).house
housearray(3).house = housearray(4).house
housearray(4).house = temp2
End If
n = n + 1
Loop

Print "Sorted"
Print housearray(1).score
Print housearray(2).score
Print housearray(3).score
Print housearray(4).score
End If


I get the numbers 5, 5, 20, 10 instead of 20, 10, 5, 5

Can anyone help?

Whats Wrong With This Code
can anyone tell me why this won't find the word im searching for? when i put the word itself in the place of text1.text it will find it but i need to be able to search different words.
Dim intpress As String
intpress = Text1.Text
strDude = "c:windowssystempersonnel.txt"
If InStr(strDude, "*" & Text1.Text & "*") Then
MsgBox "Found in string"
End If

Whats Wrong With This Code...
All this code does is showing a message box on a spcified time.


Code:
Option Explicit
Private Sub Form_Load()
If "h:mm:ss" = "20:00:00" Then
MsgBox "hello"
Else
End If
End Sub


Private Sub Timer1_Timer()
Label1.Caption = Format(Now, "h:mm:ss")
End Sub

I made this a few months ago and it worked but it seems that im forgetting something.

Whats Wrong In This VB Code?
I am using this code to query AD and just as a test I want to echo a
message box if my machinename is found in the domain.

I created the code in notepad. I used my domain and machine name information in the code and saved it as a vbs file.

I get the error message below on running the code. Why?

C:WINDOWS>cscript c: empvbtest.vbs
Microsoft (R) Windows Script Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

c: empvbtest.vbs(22, 4) Microsoft VBScript compilation error: Expected statement

## Below is the code ##

Code:
Option Explicit

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

objCommand.CommandText = _
"<LDAP://dc=childdomain,dc=primary,dc=com>;(objectCategory=computer)" & _
";distinguishedName,name;subtree"

Set objRecordSet = objCommand.Execute

While Not objRecordSet.EOF

If objRecordSet.Fields("Name") = "mymachinename" Then
Wscript.Echo objRecordSet.Fields("Name")
Wscript.Echo "[" & objRecordSet.Fields("distinguishedName") & "]"
Else
objRecordSet.MoveNext
EndIF

Wend
objConnection.Close

Whats Wrong With This Code
Private Sub mnu_open1_Click()
CommonDialog1.ShowOpen
Call Load_Txt(CommonDialog1.FileName, Text1)
End Sub


what wrong with this code?

Whats Wrong With This Code?
the text part isnt right


WebBrowser1.Navigate "http://www. * * * * * * * * * * */shop.php?qty="&text1.text&" &item_id=1&buy=Buy"

Whats Wrong With This Code?
hi i have a problem with this code and get the error message "Object invalid or no longer set" and i dont know why the idea of the code is when the button is pressed a database containing data about different types of media ( its a project for school making a videoshop ordering system) is sorted on the number of times rented field so that it will write them to a list box from the database in accending order. heres the first problem my code i think if i get it working will put them in decending order. any ideas how to fix this and also is there a better way of doing this as this method is very sloppy i feel. any ideas much appreciated.

Private Sub Command1_Click()
For Counter = 1 To 500
Data1.Recordset.OpenRecordset
Data1.Recordset.MoveFirst
Do Until Data1.Recordset.EOF
x = Data1.Recordset("number of times rented")
y = Data1.Recordset("media name")
If (x = Counter) Then
List1.AddItem ((y) & (x))
Data1.Recordset.MoveNext
Else
Data1.Recordset.MoveNext
End If
Loop
Data1.Recordset.Close
Next Counter
End Sub

Whats Wrong With My Code?
Private Sub cmdAnswer_Click()
If txtAnswer.Text = "idiot" Then
Answer = MsgBox("Great! move on the question 2 of the easy section", vbInformation, "1/7", 0, 0)
Else: txtAnswer.Text = "Wrong try again you baka!"
End If
If txtAnswer.Text = "neko" Then
MsgBox ("well done")
End If
End Sub


thanx

Whats Wrong With This Code
there is an input box on web page..
called buy_weapon[27
the value is set to zero
I like to input the value one any ideas on how to do this please

this is the html:
<TD align=middle><INPUT size=3 value=0 name=buy_weapon[27]></TD>
<INPUT type=submit value="Process Order" name=buybut>

this is the code I trying to use:
WebBrowser1.Document.Forms(0).[buy_weapon[x]].Value = 1
WebBrowser1.Document.Forms(0).submit

but obviously wrong cause I getting an eror on first line of code.

Whats Wrong With This Code:
Code:
Dim Db As Database
Dim rs As Recordset
Dim month As String
Dim maintenance As String


Set Db = OpenDatabase(App.Path & "db1.mdb") 'opens the database
Set rs = Db.OpenRecordset("Flights") 'sets the recordset

month = cmbMonth.Text
maintenance = Label1.Caption

Data1.RecordSource = "SELECT Day, Month, Plane From Flights WHERE (((flights.origin) =" & "'" & maintenance _
& "'" & ")" & "AND ((flights.destination)=" & "'" & maintenance & "'" & ")" & "AND ((flights.month)=" _
& "'" & month & "'" & ")"
Data1.Refresh

Im trying to fill a flexgrid with info using the above SQL query - but when i click the command button that the query's attached to, nothing happens. ive got the data1 control as the flexgrid's datasource, anyone got ideas what might be wrong with the code???

btw the database DOES have the info im looking for, so thats not the problem.

Whats Wrong With Code?
I have a sub that checks how many running exe's of the same name are running. The code works when added to a listbox and then checked for the exe name, But when assigned to a variable it does not.
I do not want add it to a listbox, why does this not work?


Code:
Private Sub Command1_Click()
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim success As Long
Dim ExesRunning As Integer
Dim Holder As String
Dim ExeName as string

ExeName = "Myexe.exe"


hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)

If hSnapShot = -1 Then Exit Sub

uProcess.dwSize = Len(uProcess)
success = ProcessFirst(hSnapShot, uProcess)

If success = 1 Then

Do

Holder = uProcess.szExeFile
If Holder = ExeName Then
ExesRunning = ExesRunning + 1
MsgBox Holder
End If

List1.AddItem uProcess.szExeFile
If List1.List(List1.ListCount - 1) = ExeName Then
ExesRunning = ExesRunning + 1



End If

Loop While ProcessNext(hSnapShot, uProcess)

End If

Call CloseHandle(hSnapShot)
End Sub

Whats Wrong With My Code?!?
Ok.I loaded a shockwave flash object at my form and now in that shockwave flash i wanted to load another .swf here is the coding
just some names:
SW1 = Shockwave flash Object
CD1 = Common Dialog
---

VB Code:
call SW1.LoadMovie(100, app.path+"swfname.swf")

--
but i wanted to do it with common dialog control heres what i wrote


J++ Code:
Private Sub Command18_Click()
On Error Resume Next
Dim Item As String
With CD1
        .Filter = ".SWF(*.swf)|*.swf"
        .FilterIndex = 2
        .CancelError = False
        On Error GoTo Errhandler
        .ShowOpen
        Open .FileName For Input As #3
            Do While Not EOF(3)
            Line Input #3, Item
                If Len(Item) > 100 Then
                    Call SW1.LoadMovie(3, Item)
                End If
            Loop
        Close #3
End With
Exit Sub
Exit Sub
Errhandler:
End Sub


Whats wrong with it please help me wont load the swf on the SW1

Whats Wrong With This Code ?
'<something>press A to jump</something>
Private Function GetInBetween(ByVal After As String, ByVal Before As String, InText As String, Optional ByVal StartPosition As Long = 1) As String
Dim lonStart As Long, lonLenAfter As Long
Dim lonPosAfter As Long, lonLenBefore As Long
Dim lonPosBefore As Long

'Get a valid start position if one wasn't provided.
If StartPosition <= 0 Then
lonStart = 1
Else
lonStart = StartPosition
End If

'Length of After string.
lonLenAfter = Len(After)
'Length of before string.
lonLenBefore = Len(Before)

'Find after in the string (ie: <something>)
'vbTextCompare used so it's not case-sensitive.
lonPosAfter = InStr(lonStart, InText, After, vbTextCompare)

If lonPosAfter > 0 Then 'Found the starting string.
'Find the end string, starting from where we found the starting one.
lonLenBefore = InStr(lonPosAfter, InText, Before, vbTextCompare)

If lonLenBefore > 0 Then 'Found the ending string.
lonPosAfter = lonPosAfter + lonLenAfter

GetInBetween = Mid$(InText, lonPosAfter, (lonLenBefore - lonPosAfter))
End If

End If

End Function

Private Sub Command1_Click()
Dim strHTML As String, strData As String
WebBrowser1.Navigate "http://cheats.gamez.com/cheats/" & Text1.Text & "/" & Text2.Text & ".html"
'An HTML string to use.
strHTML = WebBrowser1.Document.InnerHTML

strData = GetInBetween("<SPAN CLASS=" & Chr(34) & "arial fontsize_13" & Chr(34) & ">", "<table class=" & Chr(34) & "tborder inc_quicktopic_tborder" & Chr(34) & " width=" & Chr(34) & "100%" & Chr(34), strHTML, 1)
Debug.Print strData

End Sub







i need to know what is wrong with this code,

Whats Wrong With This Code
hello
i m using the following code to show report


VB Code:
Public Sub ChkExpense()     MdateQry = " BETWEEN #" & VBA.Format(Me.TxtFrom, "MM/DD/YYYY") & "# And #" & VBA.Format(Me.TxtTo, "MM/DD/YYYY") & "#"        Set Rs = New ADODB.Recordset    With Rs        .Open "Select * from Tbl_Adjustment where Adj_Date" & MdateQry, Db, adOpenDynamic, adLockOptimistic         Report.Database.SetDataSource Rs        CRViewer1.ReportSource = Report     '   Report.RecordSelectionFormula = "{Tbl_Payment_Receipt.Rec_No} = " & FrmRecovery.TxtNo & ""            Report.FormulaFields.Item(1).Text = Chr(34) & TxtFrom.Text & Chr(34)        Report.FormulaFields.Item(2).Text = Chr(34) & TxtTo.Text & Chr(34)         StrSelectionFormula = "{Tbl_Adjustment.Adj_Date} in Date(" & _        Format(Me.TxtFrom, "yyyy,m,d") & ") to Date(" & _        Format(Me.TxtTo, "yyyy,m,d") & ")"                        Report.RecordSelectionFormula = StrSelectionFormula        CRViewer1.ViewReport            CRViewer1.Zoom 95        Report.DiscardSavedData    End WithEnd Sub

The problem is that when i entered the date for the same month, it shows the reuslt lik 01/10/2006 to 30/10/2006

But when i entered the date between 2 months it shows nothing like
01/10/2006 to 10/11/2006

Whats wrong with this code. please help me.
Farooq

Whats Wrong In My Code ?
Dear all,

Please guide me !!! (with the help of this forum I developed these codes)


VB Code:
Option ExplicitDim cn As ADODB.Connection, rs As ADODB.Recordset, conn As String, qsql As String Private Sub Command5_Click()Form20.Visible = FalseForm19.Visible = TrueUnload MeEnd Sub Private Sub Form_Load()conn = "Provider = Microsoft.Jet.OLEDB.3.51;Data source=E:VBpromasterdb.mdb"Set cn = New ADODB.ConnectionWith cn.ConnectionString = conn.CursorLocation = adUseClient.OpenEnd WithSet rs = New ADODB.Recordsetrs.Open "y2k", cn, adOpenDynamic, adLockOptimistic, adCmdTableEnd Sub Private Sub cmddelete_click()Dim responce As Integerdisplayresponce = MsgBox("Work Order No: " & rs!work_o_no & "Date : " & rs!date_wo, vbYesNo + vbDefaultButton2, "Delete Record")If responce = vbNo Then Exit SubWith rs.Delete.MovePreviousIf .EOF Then .MoveLastIf .BOF Then .MoveFirstEnd WithdisplayEnd Sub Private Sub cmdsearch_click()Dim findstr As String, rssearch As ADODB.Recordsetfindstr = "select * from y2k where work_o_no='" & Text32.Text & "'"Set rssearch = New ADODB.Recordsetrssearch.Open findstr, cn, adOpenDynamicIf rssearch.EOF And rssearch.BOF ThenMsgBox "Search Could not find any matching data", vbInformation, "Invalid search criteria"GoTo closeRssearch:End If Text32.Text = rssearch!work_o_noText3.Text = rssearch!date_wo Text1.Text = rssearch!CountText2.Text = rssearch!yarnText4.Text = rssearch!millText5.Text = rssearch!qty Text6.Text = rssearch!count1Text7.Text = rssearch!yarn2Text8.Text = rssearch!mill1Text9.Text = rssearch!qty1 Text10.Text = rssearch!k_diaText11.Text = rssearch!k_ggText12.Text = rssearch!k_gsmText13.Text = rssearch!k_qty_req Text14.Text = rssearch!k_dia1Text15.Text = rssearch!k_gg1Text16.Text = rssearch!k_gsm1Text17.Text = rssearch!k_qty_req1 Text18.Text = rssearch!k_dia2Text19.Text = rssearch!k_gg2Text20.Text = rssearch!k_gsm2Text21.Text = rssearch!k_qty_req2 Text22.Text = rssearch!k_dia3Text23.Text = rssearch!k_gg3Text24.Text = rssearch!k_gsm3Text25.Text = rssearch!k_qty_req3 Text26.Text = rssearch!k_dia4Text27.Text = rssearch!k_gg4Text28.Text = rssearch!k_gsm4Text29.Text = rssearch!k_qty_req4 Text30.Text = rssearch!k_req_dtText31.Text = rssearch!k_pro_loss Text33.Text = rssearch!buyerText34.Text = rssearch!OrderText35.Text = rssearch!supplierText36.Text = rssearch!add1Text37.Text = rssearch!add2Text38.Text = rssearch!phText39.Text = rssearch!cell closeRssearch:rssearch.Close: Set rssearch = NothingExit SubEnd Sub Private Sub display() Text32.Text = rs!work_o_noText3.Text = rs!date_wo Text1.Text = rs!CountText2.Text = rs!yarnText4.Text = rs!millText5.Text = rs!qty Text6.Text = rs!count1Text7.Text = rs!yarn2Text8.Text = rs!mill1Text9.Text = rs!qty1 Text10.Text = rs!k_diaText11.Text = rs!k_ggText12.Text = rs!k_gsmText13.Text = rs!k_qty_req Text14.Text = rs!k_dia1Text15.Text = rs!k_gg1Text16.Text = rs!k_gsm1Text17.Text = rs!k_qty_req1 Text18.Text = rs!k_dia2Text19.Text = rs!k_gg2Text20.Text = rs!k_gsm2Text21.Text = rs!k_qty_req2 Text22.Text = rs!k_dia3Text23.Text = rs!k_gg3Text24.Text = rs!k_gsm3Text25.Text = rs!k_qty_req3 Text26.Text = rs!k_dia4Text27.Text = rs!k_gg4Text28.Text = rs!k_gsm4Text29.Text = rs!k_qty_req4 Text30.Text = rs!k_req_dtText31.Text = rs!k_pro_loss Text33.Text = rs!buyerText34.Text = rs!OrderText35.Text = rs!supplierText36.Text = rs!add1Text37.Text = rs!add2Text38.Text = rs!phText39.Text = rs!cell End Sub Private Sub cmdAdd_click()rs.AddNewcmdADD.Visible = FalsecmdEdit.Visible = FalsecmdSave.Visible = TruecmdCancel.Visible = TruecmdSearch.Enabled = FalsecmdDelete.Enabled = FalseEnd Sub Private Sub cmdCancel_click()rs.CancelUpdatecmdADD.Visible = TruecmdEdit.Visible = TruecmdSave.Visible = FalsecmdCancel.Visible = FalsecmdSearch.Enabled = TruecmdDelete.Enabled = TruedisplayEnd Sub Private Sub cmdEdit_click()displayText32.SetFocuscmdADD.Visible = FalsecmdEdit.Visible = FalsecmdSave.Visible = TruecmdCancel.Visible = TruecmdSearch.Enabled = FalsecmdDelete.Enabled = FalseEnd Sub Private Sub cmdSave_click()On Error GoTo eh:rs!work_o_no = Text32.Textrs!date_wo = Text3.Text rs!Count = Text1.Textrs!yarn = Text2.Textrs!mill = Text4.Textrs!qty = Text5.Text rs!count1 = Text6.Textrs!yarn1 = Text7.Textrs!mill1 = Text8.Textrs!qty1 = Text9.Text rs!k_dia = Text10.Textrs!k_gg = Text11.Textrs!k_gsm = Text12.Textrs!k_qty_req = Text13.Text rs!k_dia1 = Text14.Textrs!k_gg1 = Text15.Textrs!k_gsm1 = Text16.Textrs!k_qty_req1 = Text17.Text rs!k_dia2 = Text18.Textrs!k_gg2 = Text19.Textrs!k_gsm2 = Text20.Textrs!k_qty_req2 = Text21.Text rs!k_dia3 = Text22.Textrs!k_gg3 = Text23.Textrs!k_gsm3 = Text24.Textrs!k_qty_req3 = Text25.Text rs!k_dia4 = Text26.Textrs!k_gg4 = Text27.Textrs!k_gsm4 = Text28.Textrs!k_qty_req4 = Text29.Text rs!k_req_dt = Text30.Textrs!k_pro_loss = Text31.Text rs!buyer = Text33.Textrs!Order = Text34.Textrs!supplier = Text35.Textrs!add1 = Text36.Textrs!add2 = Text37.Textrs!ph = Text38.Textrs!cell = Text39.Text rs.Update cmdADD.Visible = TruecmdEdit.Visible = TruecmdSave.Visible = FalsecmdCancel.Visible = FalsecmdSearch.Enabled = TruecmdDelete.Enabled = True displayExit Sub eh:If Err.Number = -2147217900 ThenCall MsgBox("duplicate entry exists, use a different Work Order Number", vbCritical, "Error")rs.CancelUpdateElseMsgBox Err.Source & "reports" & Err.Description, , "Error" & Err.NumberEnd IfResume NextEnd Sub


For your reference i have attached the form also.

Please.

Whats Wrong With This Code
Hi

Please scan someone help me fix this code, i have a field in an access database called "Covers" it is a number field and i am trying to get the sum of covers for the current date, but the code below only counts the records.

Dim MyConn As ADODB.Connection
Dim MyRecSet As ADODB.Recordset
Dim sSQL As String
Set MyConn = New ADODB.Connection
Set MyRecSet = New ADODB.Recordset
MyConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:quick-resdatadata.mdb;"
MyConn.Open
sSQL = "SELECT SUM(Covers) FROM Guests Where [Arrival Date] = #" & Format(Date, "d/m/yyyy") & "#"

MyRecSet.Open sSQL, MyConn, adOpenStatic, adLockReadOnly

txtCovers.Text = MyRecSet.Fields("Covers")

Please can someone advise me.

Many thanks.

Whats Wrong With This Code?
Can anybody find the problem with this code???
It works well with in the visual basic editor.But once exe is made,not working.
str & destDirectory are strings.

str = destDirectory & "" & txtHistory
FileCopy txtFilename, str
If (Check1.Value = 1) Then
Kill (txtFilename)
End If
MsgBox "Ok"

Help :whats Wrong With Code?
hi,

this code below is not working can some one tell me why it giving message not empty even when there is nothing in folllow_up_date.

dt = rs.Fields("Followup_date")

If Trim(dt) = "" Then
MsgBox "empty"
Else
MsgBox "not empty" & dt
dtp_fllowup_dt.Value = rs.Fields("Followup_date") & ""
End If

Whats Wrong With This Code?
Hi

Please can someone tell me what is wrong with this code, i figured out how to get a picture into cells and merge them, with a friends help, but the code below puts the picture in one place only, i can see why its doing that but cant figure out how to change it. Basically i need the picture to appear in the cells that i have selected. Please help
VB Code:
Private Sub fg_Click()fg.MergeCells = flexMergeFreefg.MergeRow(3) = Truefg.MergeRow(4) = True    fg.TextMatrix(3, 3) = "Heading One"    fg.TextMatrix(3, 4) = "Heading One"     fg.Row = 3      fg.Col = 3fg.CellPicture = LoadPicture("C:logo.bmp")end Sub
Many thanks in advance

Whats Wrong With My Code?
VB Code:
Option ExplicitDim string1 As StringDim string2 As StringDim positionDim newWord, newStr, LowerCaps As String Private Sub getallflc_Click()string1 = txtbox1position = InStr(string1, " ")While position    newWord = Left$(string1, position)    If newWord = UCase$(Left$(newWord, 1) & Mid$(newWord, 2)) Then        newStr = newStr & newWord    End If    string1 = Right$(string1, Len(string1) - position) ' errorWend    newWord = string1    If newWord = UCase$(Left$(newWord, 1) & Mid$(newWord, 2)) Then        newStr = newStr & newWord    End If    txtbox2 = newStrEnd Sub

--> Run-time error '5':
Invalid procedure call or argument

Thanks for the reply

Whats Wrong With This Code?
hi, please take a look at this code


VB Code:
Private Sub cmdGenerate_Click()Dim sText As StringWebBrowser1.Navigate "http://nokiasecuritycode.com/details.php"Do While (WebBrowser1.ReadyState <> READYSTATE_COMPLETE)DoEventsLoopWebBrowser1.Document.Forms("The_Form").elements("imei").Value = txtimei.TextsText = WebBrowser1.Document.Body.innerTexttxtmastercode.Text = Right$(sText, Len(sText) - InStrRev(sText, " "))End Sub


i got an error in The_Form

what is The_Form?

thanks

Whats Wrong With This Code?
VB Code:
Shell "C:Program FilesWindows Media Playerwmplayer.exe""cd.FileName""", vbNormalFocus


I know this code is completely wrong, but what i'm trying to do is get Windows Media Player to load the file name of the common dialog control(cd). the file name is the path to the file I wanted to open with WMPlayer.

Is there an alternative?

...:::ONE:::...

Whats Wrong With This Code ???
Hello,

What is wrong with this code ???


Dll code:

VB Code:
Public Function List()lstlist.AddItem "List 1End Function


Visual Basic code:
Private Sub Form_Load()
List
End Sub


But it give's an error when i run the application
Error: Object Required

Help would be appriciated

Whats Wrong With This Code ???
Hello,

What is wrong with this code ???


Dll code:

VB Code:
Public Function List()lstlist.AddItem "List 1End Function


Visual Basic code:
Private Sub Form_Load()
List
End Sub


But it give's an error when i run the application
Error: Object Required

Help would be appriciated

Whats Wrong With My Code?
Here is my code , when i debug im gettin an error at CreateObject("Outlook.Application")


Code:

Private Sub Command2_Click()
Dim App As Object
Dim Itm As Object

Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = "Registration for UOHelper"
.To = "e-mail@email"
.Body = "Hehe"
.Attachment = "File"
.Send
End With

End Sub

Whats Wrong In This Code?
hi all,
I have a simple vbcode here using ADOX.But its not working. Will you pls help me

Thanx in Advance
Stanly Mathew

VB Code:
Option ExplicitDim cn As ConnectionDim cat As ADOX.CatalogDim cmd As New ADODB.CommandDim rs As New ADODB.Recordset Private Sub Form_Load()    Set cn = New ADODB.Connection    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:WINDOWSDesktopdb2.mdb"End Sub Private Sub Command1_Click()    Set cat = New ADOX.Catalog    Set cat.ActiveConnection = cn        cmd.CommandText = "SELECT * FROM Table1 where age=25 "    cat.Procedures.Delete "ty"    Set cat = Nothing    Set cat = New ADOX.Catalog    Set cat.ActiveConnection = cn    cat.Procedures.Append "Ty", cmd    Set MSHFlexGrid1.DataSource = ty    Set cmd = Nothing    Set cat = Nothing End Sub

Whats Wrong With This Code?
im trying to make a recent files part, in the file menu, but i cant get this code to work properly:

VB Code:
'move all recent files down by one        '5        recent5.Caption = GetSetting(App.EXEName, "recentname4", "STRING", "Demo")        recentpath5 = GetSetting(App.EXEName, "recentpath4", "STRING", App.Path & "Demo/Demo.tap")        SaveSetting App.EXEName, "recentname5", "STRING", recentname4        SaveSetting App.EXEName, "recentpath5", "STRING", recentpath4        '4        recent4.Caption = GetSetting(App.EXEName, "recentname3", "STRING", "Demo")        recentpath4 = GetSetting(App.EXEName, "recentpath3", "STRING", App.Path & "Demo/Demo.tap")        SaveSetting App.EXEName, "recentname4", "STRING", recentname3        SaveSetting App.EXEName, "recentpath4", "STRING", recentpath3        '3        recent3.Caption = GetSetting(App.EXEName, "recentname2", "STRING", "Demo")        recentpath3 = GetSetting(App.EXEName, "recentpath2", "STRING", App.Path & "Demo/Demo.tap")        SaveSetting App.EXEName, "recentname3", "STRING", recentname2        SaveSetting App.EXEName, "recentpath3", "STRING", recentpath2        '2        recent2.Caption = GetSetting(App.EXEName, "recentname", "STRING", "Demo")        recentpath2 = GetSetting(App.EXEName, "recentpath", "STRING", App.Path & "Demo/Demo.tap")        SaveSetting App.EXEName, "recentname2", "STRING", recentname        SaveSetting App.EXEName, "recentpath2", "STRING", recentpath        '1        SaveSetting App.EXEName, "recentname", "STRING", projectname        SaveSetting App.EXEName, "recentpath", "STRING", projectpath        'done        recentfile.Caption = GetSetting(App.EXEName, "recentname", "STRING", "Demo")        recent2.Caption = GetSetting(App.EXEName, "recentname2", "STRING", "Demo")        recent3.Caption = GetSetting(App.EXEName, "recentname3", "STRING", "Demo")        recent4.Caption = GetSetting(App.EXEName, "recentname4", "STRING", "Demo")        recent5.Caption = GetSetting(App.EXEName, "recentname5", "STRING", "Demo")

any help appreciated

Whats Wrong With This Code??
Whats wrong with this coded? I'm getting a compile error Block if Without End If And Its highlighting the End Sub??

VB Code:
Private Sub Label3_Click()Dim strHtml As String ' Open the profile to the variablestrHtml$ = Inet1.OpenUrl("http://profiles.yahoo.com/" & txtUserName) ' Check if they are a valid memberIf InStr(1, UCase(strHtml$), UCase("Sorry, but the profile you are looking for is not currently available")) Then GoTo NonExistant ' Get the online page.strOnline$ = Inet1.OpenUrl("http://opi.yahoo.com/online?u=" & txtUserName.Text)              'If there isn't a seperator, exit the sub    If Separator = False Then: Exit Sub                ' Strip the URL and Session ID    Filename$ = Strip_URL(Url$)        '''''''''''''''''''''''''''''''' Display Profile information ''''''''''''''''''''''''''''''''lbllast_updated = Last_Update(strHtml$)If InStr(1, strOnline$, "NOT") Then    lblstatus.Caption = "Offline"Else    lblstatus.Caption = "Online"  WAVSound "click"Dim sURL As StringsURL = Trim("http://profiles.yahoo.com/" & Form1.List2.Text)If Len(sURL) > 0 ThenForm2.WebBrowser1.Navigate sURLForm2.ShowEnd Sub

Copyright © 2005-08 www.BigResource.com, All rights reserved